move stuff to different files, fix duplicate overlay problem!

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)

mfm/small.el

@@ -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)
+      )))

sharkey.el

@@ -14,108 +14,10 @@
 ;; 日本語
 
 (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)
   "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."
+  ;; buffer local
+  (if fedimoji-mode
+      (progn
+	(font-lock-remove-keywords nil
+				   `(,sharkey/emoji-rx))
+	(mir/remove-all-overlays))
     (font-lock-add-keywords
-   nil ; no really, it has to be nil
+     nil					; this must needs be nil
-   '((next-emoji-overlay
+     `((,sharkey/emoji-rx (0  'font-lock-keyword-face t))
-      (0  'font-lock-keyword-face t)))
+       (next-small-overlay (0  'font-lock-keyword-face t))
-   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
+	   ;; (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)))
 	 )
     (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))
+	     (mir/box-around-body
-	 (concat "\n┗" (make-string (- toot-char-width 2) ?━) "┛")
+	      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)
+       ;; (propertize (concat "\n  " mastodon-tl--horiz-bar)
-                   'face 'default)
+       ;;             'face 'default)
        (if (and mastodon-tl--show-stats
                 (not (member type '("follow" "follow_request"))))
            (mastodon-tl--toot-stats toot)