From b1b31002926dbee62e5e8490c238b2d33f1178d7 Mon Sep 17 00:00:00 2001 From: Miranda Marquez Date: Mon, 30 Sep 2024 09:58:43 -0800 Subject: [PATCH] move stuff to different files, fix duplicate overlay problem! --- mfm/emoji.el | 67 +++++++++++++++++ mfm/small.el | 41 +++++++++++ sharkey.el | 198 ++++++++++++++++++++------------------------------- 3 files changed, 184 insertions(+), 122 deletions(-) create mode 100644 mfm/emoji.el create mode 100644 mfm/small.el 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)