move stuff to different files, fix duplicate overlay problem!
This commit is contained in:
parent
77fac38771
commit
b1b3100292
67
mfm/emoji.el
Normal file
67
mfm/emoji.el
Normal file
@ -0,0 +1,67 @@
|
|||||||
|
;; need to figure out custom emoji resolution
|
||||||
|
|
||||||
|
;; let's start by making :rena: render as the rena.webp image...
|
||||||
|
|
||||||
|
:neocat_pat_floof::3:
|
||||||
|
:neofetch:
|
||||||
|
(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."
|
||||||
|
;; 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))
|
||||||
|
(cache (sharkey--emoji-cache emoj)))
|
||||||
|
(unless (mir/overlay-already-at-p beg end)
|
||||||
|
(if cache
|
||||||
|
(let ((img (create-image cache
|
||||||
|
(if (image-type-available-p 'imagemagick)
|
||||||
|
'imagemagick
|
||||||
|
'webp)
|
||||||
|
nil
|
||||||
|
:height (window-font-height)
|
||||||
|
:ascent 'center))
|
||||||
|
(multi (image-multi-frame-p cache))
|
||||||
|
(ov (make-overlay beg end)))
|
||||||
|
(image-animate img nil t)
|
||||||
|
(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))))))))
|
||||||
|
;; :megumin_bakuretsu:
|
||||||
|
;; (defun mir/timer-at-p)
|
41
mfm/small.el
Normal file
41
mfm/small.el
Normal file
@ -0,0 +1,41 @@
|
|||||||
|
(defvar sharkey/small-rx
|
||||||
|
;; this might display a bit weird... sorgy
|
||||||
|
(rx (group-n 1 "<small" ">")
|
||||||
|
(group-n 2 (+? (or "\n" 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)
|
||||||
|
;; (put-text-property text-beg text-end 'display '(height 0.8))
|
||||||
|
(overlay-put placehoverlay 'display '(height 0.8))
|
||||||
|
(overlay-put placehoverlay 'mfm-tag "small")
|
||||||
|
(overlay-put placehoverlay 'modification-hooks
|
||||||
|
(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
|
||||||
|
(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)
|
||||||
|
)))
|
198
sharkey.el
198
sharkey.el
@ -14,108 +14,10 @@
|
|||||||
;; 日本語
|
;; 日本語
|
||||||
|
|
||||||
(require 'shr)
|
(require 'shr)
|
||||||
|
(require 'mastodon)
|
||||||
|
|
||||||
;; need to figure out custom emoji resolution
|
(load-file "./mfm/emoji.el")
|
||||||
|
(load-file "./mfm/small.el")
|
||||||
;; let's start by making :rena: render as the rena.webp image...
|
|
||||||
|
|
||||||
:neocat_pat_floof::3:
|
|
||||||
(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)
|
|
||||||
(if (image-type-available-p 'imagemagick)
|
|
||||||
'imagemagick
|
|
||||||
'webp)
|
|
||||||
nil
|
|
||||||
:height (window-font-height)
|
|
||||||
:ascent 'center))
|
|
||||||
(ov (make-overlay beg end)))
|
|
||||||
(image-animate img nil t)
|
|
||||||
(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
|
|
||||||
;; this might display a bit weird... sorgy
|
|
||||||
(rx (group-n 1 "<small>")
|
|
||||||
(group-n 2 (+? (or "\n" 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)
|
|
||||||
;; (put-text-property text-beg text-end 'display '(height 0.8))
|
|
||||||
(overlay-put placehoverlay 'display '(height 0.8))
|
|
||||||
(overlay-put placehoverlay 'mfm-tag "small")
|
|
||||||
(overlay-put placehoverlay 'modification-hooks
|
|
||||||
(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
|
|
||||||
(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)
|
|
||||||
)))
|
|
||||||
(defun mir/remove-all-overlays (&optional overlay nyl beg end)
|
(defun mir/remove-all-overlays (&optional overlay nyl beg end)
|
||||||
"Delete all overlays resting on current line."
|
"Delete all overlays resting on current line."
|
||||||
;; (message "%s" throwaway)
|
;; (message "%s" throwaway)
|
||||||
@ -131,6 +33,15 @@ returns nil if such an emoji does not exist."
|
|||||||
(cons
|
(cons
|
||||||
(overlay-start overlay)
|
(overlay-start overlay)
|
||||||
(overlay-end 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
|
(defface mfm-delimiter-invis-face
|
||||||
'((t (:string "")))
|
'((t (:string "")))
|
||||||
"Face for misskey markdown elements such as <small\> type stuff.")
|
"Face for misskey markdown elements such as <small\> type stuff.")
|
||||||
@ -140,31 +51,77 @@ returns nil if such an emoji does not exist."
|
|||||||
|
|
||||||
(font-lock-add-keywords
|
(font-lock-add-keywords
|
||||||
nil ; this must needs be nil
|
nil ; this must needs be nil
|
||||||
|
;; 'fedimoji-mode
|
||||||
`((next-emoji-overlay (0 'font-lock-keyword-face t))
|
`((next-emoji-overlay (0 'font-lock-keyword-face t))
|
||||||
(next-small-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 1 'mfm-delimiter-invis-face t)
|
||||||
;; (,sharkey/small-rx 3 'mfm-delimiter-invis-face t)
|
;; (,sharkey/small-rx 3 'mfm-delimiter-invis-face t)
|
||||||
) t)
|
) t)
|
||||||
|
;; (defun )
|
||||||
|
(defvar fedimoji-mode nil)
|
||||||
(define-minor-mode fedimoji-mode
|
(define-minor-mode fedimoji-mode
|
||||||
"Display colon-delimited fediverse emoji properly."
|
"Display colon-delimited fediverse emoji properly."
|
||||||
(font-lock-add-keywords
|
;; buffer local
|
||||||
nil ; no really, it has to be nil
|
(if fedimoji-mode
|
||||||
'((next-emoji-overlay
|
(progn
|
||||||
(0 'font-lock-keyword-face t)))
|
(font-lock-remove-keywords nil
|
||||||
t)
|
`(,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-mode #'fedimoji-mode)
|
||||||
(add-hook 'mastodon-toot-mode-hook #'fedimoji-mode)
|
(add-hook 'mastodon-toot-mode-hook #'fedimoji-mode)
|
||||||
;; ":neofox:" <-- this fucking fox is breaking my syntax highlighting
|
;; ":neofox:" <-- this fucking fox is breaking my syntax highlighting
|
||||||
;; can we do animated? :nixos-3d:
|
;; can we do animated? :nixos-3d:
|
||||||
;; apparently so... :silvervale_waves:
|
;; apparently so... :silvervale_waves:
|
||||||
|
;; :megumin_bakuretsu: la la la :3
|
||||||
|
|
||||||
;; (defun mfm-render (input)
|
;; (defun mfm-render (input)
|
||||||
;; "Convert INPUT plain text to propertized rich text using the implemented set of misskey flavored markdown."
|
;; "Convert INPUT plain text to propertized rich text using the implemented set of misskey flavored markdown."
|
||||||
;; (--> input
|
;; (--> input
|
||||||
;; (string-replace )))
|
;; (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?
|
;; default from mastodon.el - how can we destroy it?
|
||||||
(defun mastodon-tl--insert-status (toot body author-byline action-byline
|
(defun mastodon-tl--insert-status (toot body author-byline action-byline
|
||||||
&optional id base-toot detailed-p
|
&optional id base-toot detailed-p
|
||||||
@ -201,12 +158,14 @@ NO-BYLINE means just insert toot body, used for folding."
|
|||||||
;; a mir addition:
|
;; a mir addition:
|
||||||
(toot-char-width
|
(toot-char-width
|
||||||
(min
|
(min
|
||||||
(max
|
;; (max
|
||||||
(apply #'max (--map (length it)
|
;; (apply #'max (--map (length it)
|
||||||
(split-string body "\n")))
|
;; (split-string body "\n")))
|
||||||
;; o thank gosh, max can take one arg
|
;; ;; o thank gosh, max can take one arg
|
||||||
;; want to add image width when figure out how
|
;; ;; 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)))
|
(window-width nil 'remap)))
|
||||||
)
|
)
|
||||||
(insert
|
(insert
|
||||||
@ -220,11 +179,6 @@ NO-BYLINE means just insert toot body, used for folding."
|
|||||||
detailed-p domain))
|
detailed-p domain))
|
||||||
(propertize
|
(propertize
|
||||||
(concat
|
(concat
|
||||||
;; mir: box draw at top of post
|
|
||||||
"┏"
|
|
||||||
(make-string (- toot-char-width 2) ?━)
|
|
||||||
"┓"
|
|
||||||
"\n"
|
|
||||||
;; relpy symbol (broken):
|
;; relpy symbol (broken):
|
||||||
(if (and after-reply-status-p thread)
|
(if (and after-reply-status-p thread)
|
||||||
(concat (mastodon-tl--symbol 'replied)
|
(concat (mastodon-tl--symbol 'replied)
|
||||||
@ -246,8 +200,8 @@ NO-BYLINE means just insert toot body, used for folding."
|
|||||||
'line-prefix bar
|
'line-prefix bar
|
||||||
'wrap-prefix bar)
|
'wrap-prefix bar)
|
||||||
;; (message "%s" simplified-emoji-alist)
|
;; (message "%s" simplified-emoji-alist)
|
||||||
body))
|
(mir/box-around-body
|
||||||
(concat "\n┗" (make-string (- toot-char-width 2) ?━) "┛")
|
body toot-char-width)))
|
||||||
)
|
)
|
||||||
'toot-body t) ;; includes newlines etc. for folding
|
'toot-body t) ;; includes newlines etc. for folding
|
||||||
)
|
)
|
||||||
@ -373,8 +327,8 @@ When DOMAIN, force inclusion of user's domain in their handle."
|
|||||||
(mastodon-tl--relative-time-description edited-parsed)
|
(mastodon-tl--relative-time-description edited-parsed)
|
||||||
edited-parsed)))
|
edited-parsed)))
|
||||||
"")
|
"")
|
||||||
(propertize (concat "\n " mastodon-tl--horiz-bar)
|
;; (propertize (concat "\n " mastodon-tl--horiz-bar)
|
||||||
'face 'default)
|
;; 'face 'default)
|
||||||
(if (and mastodon-tl--show-stats
|
(if (and mastodon-tl--show-stats
|
||||||
(not (member type '("follow" "follow_request"))))
|
(not (member type '("follow" "follow_request"))))
|
||||||
(mastodon-tl--toot-stats toot)
|
(mastodon-tl--toot-stats toot)
|
||||||
|
Loading…
Reference in New Issue
Block a user