From 2e4ec6b3bb98d18eff6a6d2048cab82eb517fb20 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 08:57:48 +0200 Subject: audit media.el --- lisp/mastodon-media.el | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) (limited to 'lisp/mastodon-media.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 4d36f47..0c40ca5 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -145,7 +145,7 @@ IMAGE-OPTIONS are the precomputed options to apply to the image. MARKER is the marker to where the response should be visible. REGION-LENGTH is the length of the region that should be replaced with the image." - (when (marker-buffer marker) ; only if the buffer hasn't been kill in the meantime + (when (marker-buffer marker) ; if buffer hasn't been killed (let ((url-buffer (current-buffer)) (is-error-response-p (eq :error (car status-plist)))) (unwind-protect @@ -193,8 +193,7 @@ REGION-LENGTH is the range from start to propertize." `(:max-height ,mastodon-media--preview-max-height)))))) (let ((buffer (current-buffer)) (marker (copy-marker start)) - ;; Keep url.el from spamming us with messages about connecting to hosts: - (url-show-status nil)) + (url-show-status nil)) ; stop url.el from spamming us about connecting (condition-case nil ;; catch any errors in url-retrieve so as to not abort ;; whatever called us @@ -204,11 +203,12 @@ REGION-LENGTH is the range from start to propertize." (with-current-buffer (url-fetch-from-cache url) (set-buffer-multibyte nil) (goto-char (point-min)) - (zlib-decompress-region (goto-char (search-forward "\n\n")) (point-max)) - (mastodon-media--process-image-response nil marker image-options region-length url)) + (zlib-decompress-region + (goto-char (search-forward "\n\n")) (point-max)) + (mastodon-media--process-image-response + nil marker image-options region-length url)) ;; else fetch as usual and process-image-response will cache it - (url-retrieve url - #'mastodon-media--process-image-response + (url-retrieve url #'mastodon-media--process-image-response (list marker image-options region-length url))) (error (with-current-buffer buffer ;; TODO: Consider adding retries @@ -224,20 +224,20 @@ Returns the list of (`start' . `end', `media-symbol') points of that line and string found or nil no more media links were found." (let ((next-pos (point))) - (while (and (setq next-pos (next-single-property-change next-pos 'media-state)) - (or (not (eq 'needs-loading (get-text-property next-pos 'media-state))) - (null (get-text-property next-pos 'media-url)) - (null (get-text-property next-pos 'media-type)))) + (while + (and + (setq next-pos (next-single-property-change next-pos 'media-state)) + (or (not (eq 'needs-loading (get-text-property next-pos 'media-state))) + (null (get-text-property next-pos 'media-url)) + (null (get-text-property next-pos 'media-type)))) ;; do nothing - the loop will proceed ) (when (and next-pos (< next-pos end-pos)) (let ((media-type (get-text-property next-pos 'media-type))) (cond - ;; Avatars are just one character in the buffer - ((eq media-type 'avatar) + ((eq media-type 'avatar) ; avatars are one character (list next-pos (+ next-pos 1) 'avatar)) - ;; Media links are 5 character ("[img]") - ((eq media-type 'media-link) + ((eq media-type 'media-link) ; media links are 5 characters: [img] (list next-pos (+ next-pos 5) 'media-link))))))) (defun mastodon-media--valid-link-p (link) @@ -254,8 +254,8 @@ Replace them with the referenced image." (save-excursion (goto-char search-start) (let (line-details) - (while (setq line-details (mastodon-media--select-next-media-line - search-end)) + (while (setq line-details + (mastodon-media--select-next-media-line search-end)) (let* ((start (car line-details)) (end (cadr line-details)) (media-type (cadr (cdr line-details))) @@ -302,17 +302,18 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url - type caption) +(defun mastodon-media--get-media-link-rendering + (media-url &optional full-remote-url type caption) "Return the string to be written that renders the image at MEDIA-URL. FULL-REMOTE-URL is used for `shr-browse-image'. TYPE is the attachment's type field on the server. CAPTION is the image caption if provided." - (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview") + (let* ((help-echo-base + "RET/i: load full image (prefix: copy URL), +/-: zoom,\ +r: rotate, o: save preview") (help-echo (if caption (concat help-echo-base - "\n\"" - caption "\"") + "\n\"" caption "\"") help-echo-base))) (concat (mastodon-tl--propertize-img-str-or-url -- cgit v1.2.3 From b19390cd38ba93e527e5961723b46779749f1ee1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 11 May 2023 09:08:05 +0200 Subject: fix media tests --- lisp/mastodon-media.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-media.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 0c40ca5..fd5bb77 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -310,7 +310,7 @@ TYPE is the attachment's type field on the server. CAPTION is the image caption if provided." (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom,\ -r: rotate, o: save preview") + r: rotate, o: save preview") (help-echo (if caption (concat help-echo-base "\n\"" caption "\"") -- cgit v1.2.3 From 6afc7b87d289265f464f9ad191c2245caf1a3223 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 30 Apr 2023 16:47:55 +0200 Subject: add play symbol after videos in tl. --- lisp/mastodon-media.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-media.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index fd5bb77..1e4d8b1 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -174,7 +174,12 @@ with the image." ;; it; we already have set a default image when we ;; added the tag. (put-text-property marker (+ marker region-length) - 'display image)) + 'display image) + (when (not (equal "image" + (get-text-property marker 'mastodon-media-type))) + (let ((ov (make-overlay marker (+ marker region-length) + (marker-buffer marker)))) + (overlay-put ov 'after-string " ▶")))) ;; We are done with the marker; release it: (set-marker marker nil))) (kill-buffer url-buffer))))))) -- cgit v1.2.3 From a9e810c5e7344fb99b984e08c18f690c686a0d0b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 14:52:00 +0200 Subject: overlay for media --- lisp/mastodon-media.el | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) (limited to 'lisp/mastodon-media.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 1e4d8b1..541e6de 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -271,22 +271,27 @@ Replace them with the referenced image." ;; proceed to load this image asynchronously (put-text-property start end 'media-state 'loading) (mastodon-media--load-image-from-url - image-url media-type start (- end start)))))))) - ;; (mastodon-media--moving-image-overlay start end))))))) + image-url media-type start (- end start)) + (mastodon-media--moving-image-overlay start end))))))) -;; (defun mastodon-media--moving-image-overlay (start end) -;; "Add play symbol overlay to moving image media items." -;; (let ((ov (make-overlay start end)) -;; (type (get-text-property start 'mastodon-media-type))) -;; (when (or (equal type "gifv") -;; (equal type "video")) -;; (overlay-put -;; ov -;; 'after-string -;; (propertize " " -;; 'face -;; '((:height 1.5 :inherit 'font-lock-comment-face))))))) +;; (defvar-local mastodon-media--overlays nil +;; "Holds a list of overlays in the buffer.") +(defun mastodon-media--moving-image-overlay (start end) + "Add play symbol overlay to moving image media items." + (let ((ov (make-overlay start end)) + (type (get-text-property start 'mastodon-media-type))) + (when (or (equal type "gifv") + (equal type "video")) + (overlay-put + ov + 'after-string + (propertize "" + 'face + '((:height 3.5 :inherit 'font-lock-comment-face))))))) +;; (cl-pushnew ov mastodon-media--overlays))) + +(remove-overlays) (defun mastodon-media--get-avatar-rendering (avatar-url) "Return the string to be written that renders the avatar at AVATAR-URL." ;; We use just an empty space as the textual representation. -- cgit v1.2.3 From 6a6f7645c454c080046dc6409cc2583baef3bbab Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 15:55:57 +0200 Subject: re-do vid overlay clean up --- lisp/mastodon-media.el | 31 +++++++++++++------------------ 1 file changed, 13 insertions(+), 18 deletions(-) (limited to 'lisp/mastodon-media.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 541e6de..12d51a1 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -174,12 +174,7 @@ with the image." ;; it; we already have set a default image when we ;; added the tag. (put-text-property marker (+ marker region-length) - 'display image) - (when (not (equal "image" - (get-text-property marker 'mastodon-media-type))) - (let ((ov (make-overlay marker (+ marker region-length) - (marker-buffer marker)))) - (overlay-put ov 'after-string " ▶")))) + 'display image)) ;; We are done with the marker; release it: (set-marker marker nil))) (kill-buffer url-buffer))))))) @@ -264,6 +259,7 @@ Replace them with the referenced image." (let* ((start (car line-details)) (end (cadr line-details)) (media-type (cadr (cdr line-details))) + (type (get-text-property start 'mastodon-media-type)) (image-url (get-text-property start 'media-url))) (if (not (mastodon-media--valid-link-p image-url)) ;; mark it at least as not needing loading any more @@ -272,26 +268,25 @@ Replace them with the referenced image." (put-text-property start end 'media-state 'loading) (mastodon-media--load-image-from-url image-url media-type start (- end start)) - (mastodon-media--moving-image-overlay start end))))))) + (when (or (equal type "gifv") + (equal type "video")) + (mastodon-media--moving-image-overlay start end)))))))) ;; (defvar-local mastodon-media--overlays nil ;; "Holds a list of overlays in the buffer.") (defun mastodon-media--moving-image-overlay (start end) "Add play symbol overlay to moving image media items." - (let ((ov (make-overlay start end)) - (type (get-text-property start 'mastodon-media-type))) - (when (or (equal type "gifv") - (equal type "video")) - (overlay-put - ov - 'after-string - (propertize "" - 'face - '((:height 3.5 :inherit 'font-lock-comment-face))))))) + (let ((ov (make-overlay start end))) + (overlay-put + ov + 'after-string + (propertize "" + 'help-echo "Video" + 'face + '((:height 3.5 :inherit 'font-lock-comment-face)))))) ;; (cl-pushnew ov mastodon-media--overlays))) -(remove-overlays) (defun mastodon-media--get-avatar-rendering (avatar-url) "Return the string to be written that renders the avatar at AVATAR-URL." ;; We use just an empty space as the textual representation. -- cgit v1.2.3 From f0670d18c38051b6b950d6569aa61c9f54f35df8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 May 2023 13:06:55 +0200 Subject: don't dbl quote video overlay font --- lisp/mastodon-media.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-media.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 12d51a1..5ccc3c4 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -284,7 +284,7 @@ Replace them with the referenced image." (propertize "" 'help-echo "Video" 'face - '((:height 3.5 :inherit 'font-lock-comment-face)))))) + '((:height 3.5 :inherit font-lock-comment-face)))))) ;; (cl-pushnew ov mastodon-media--overlays))) (defun mastodon-media--get-avatar-rendering (avatar-url) -- cgit v1.2.3