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 'mastodon)
|
||||
|
||||
;; need to figure out custom emoji resolution
|
||||
|
||||
;; 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)
|
||||
)))
|
||||
(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)
|
||||
@ -131,6 +33,15 @@ returns nil if such an emoji does not exist."
|
||||
(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.")
|
||||
@ -140,31 +51,77 @@ returns nil if such an emoji does not exist."
|
||||
|
||||
(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."
|
||||
(font-lock-add-keywords
|
||||
nil ; no really, it has to be nil
|
||||
'((next-emoji-overlay
|
||||
(0 'font-lock-keyword-face t)))
|
||||
t)
|
||||
;; 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
|
||||
@ -201,12 +158,14 @@ NO-BYLINE means just insert toot body, used for folding."
|
||||
;; 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
|
||||
)
|
||||
;; (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
|
||||
@ -220,11 +179,6 @@ NO-BYLINE means just insert toot body, used for folding."
|
||||
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)
|
||||
@ -246,8 +200,8 @@ NO-BYLINE means just insert toot body, used for folding."
|
||||
'line-prefix bar
|
||||
'wrap-prefix bar)
|
||||
;; (message "%s" simplified-emoji-alist)
|
||||
body))
|
||||
(concat "\n┗" (make-string (- toot-char-width 2) ?━) "┛")
|
||||
(mir/box-around-body
|
||||
body toot-char-width)))
|
||||
)
|
||||
'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)
|
||||
edited-parsed)))
|
||||
"")
|
||||
(propertize (concat "\n " mastodon-tl--horiz-bar)
|
||||
'face 'default)
|
||||
;; (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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user