sharkey-el/sharkey.el

;;; 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))))