diff --git a/mfm/emoji.el b/mfm/emoji.el
new file mode 100644
index 0000000..77bdccc
--- /dev/null
+++ b/mfm/emoji.el
@@ -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)
diff --git a/mfm/small.el b/mfm/small.el
new file mode 100644
index 0000000..e09d395
--- /dev/null
+++ b/mfm/small.el
@@ -0,0 +1,41 @@
+(defvar sharkey/small-rx
+ ;; this might display a bit weird... sorgy
+ (rx (group-n 1 "")
+ (group-n 2 (+? (or "\n" 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)
+ ;; (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)
+ )))
diff --git a/sharkey.el b/sharkey.el
index 7588516..6632c74 100644
--- a/sharkey.el
+++ b/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 "")
- (group-n 2 (+? (or "\n" 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)
- ;; (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 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)