2024-09-14 15:41:24 -08:00
;;; 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 )
2024-09-14 16:54:17 -08:00
( mastodon-use-emojify t )
2024-09-14 15:41:24 -08:00
:demand )
;; 日本語
;; need to figure out custom emoji resolution
;; let's start by making :rena: render as the rena.webp image...
2024-09-14 16:54:17 -08:00
:neocat_pat_floof::3:
2024-09-14 15:41:24 -08:00
( 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
2024-09-14 16:54:36 -08:00
;; this might display a bit weird... sorgy
2024-09-14 15:41:24 -08:00
( rx ( group-n 1 " <small> " )
2024-09-14 16:54:36 -08:00
( group-n 2 ( +? ( or " \n " any ) ) )
2024-09-14 15:41:24 -08:00
( 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 ) )
)
2024-09-14 16:54:36 -08:00
( 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)
;; (put-text-property text-beg text-end 'display '(height 0.8))
( overlay-put placehoverlay 'display ' ( height 0.8 ) )
2024-09-14 15:41:24 -08:00
( overlay-put placehoverlay 'modification-hooks
2024-09-14 16:54:36 -08:00
( list
'mir/remove-all-overlays
'org-display-inline-remove-overlay ) )
( overlay-put openr-ov 'modification-hooks
( list 'org-display-inline-remove-overlay ) )
( overlay-put close-ov 'modification-hooks
2024-09-14 15:41:24 -08:00
( 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)
) ) )
2024-09-14 16:54:36 -08:00
( 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 ) ) )
2024-09-14 15:41:24 -08:00
( defface mfm-delimiter-invis-face
' ( ( t ( :string " " ) ) )
" Face for misskey markdown elements such as <small> type stuff. " )
2024-09-14 16:54:36 -08:00
;; the fact is, <small>this :neofox: is smol</small
;; <small>this :neocat: is also smol</small> apparently
;; <small>
;; this comment is entirely small
; </small>
2024-09-14 15:41:24 -08:00
( font-lock-add-keywords
nil ; this must needs be nil
` ( ( next-emoji-overlay ( 0 'font-lock-keyword-face t ) )
2024-09-14 16:54:36 -08:00
( 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)
2024-09-14 15:41:24 -08:00
) 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 ) ) ) )