commit e38e4e959564dc601fa9237466ea5b946b30f2ae Author: Miranda Marquez Date: Sat Sep 14 15:41:24 2024 -0800 initialize repo and add sharkey.el file diff --git a/sharkey.el b/sharkey.el new file mode 100644 index 0000000..f4f29e6 --- /dev/null +++ b/sharkey.el @@ -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 "") + (group-n 2 (+ any)) + (group-n 3 ""))) +(defun next-small-overlay (&optional limit) + "logic from `next-emoji-overlay' but for mfm 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 type stuff.") + +;; this :neofox is smol + +(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))))