toot: Add display-image? parameter.

1 files changed, 19 insertions, 10 deletions

diff --git a/toot.scm b/toot.scm
index 1af5ec9..0ce5b26 100644
--- a/toot.scm
+++ b/toot.scm
@@ -42,6 +42,7 @@
   #:export (;; parameter
             mastodon-host
             mastodon-access-token
+            display-image?
 
             ;; get
             fetch-status
@@ -111,6 +112,9 @@
 (define mastodon-access-token
   (make-parameter (getenv "MASTODON_ACCESS_TOKEN")))
 
+(define display-image?
+  (make-parameter #f))
+
 (define (created-at-string->date str)
   (time-utc->date
    (date->time-utc
@@ -224,10 +228,11 @@
         (status (notification-status notification))
         (time (notification-creation-time notification)))
     (format port
-            "[NOTIFICATION] ~:@(~a~)~%~a ~a ~a~%> "
+            "[NOTIFICATION] ~:@(~a~)~%~@[~s ~]~a ~a~%> "
             (notification-type notification)
-            (fetch-avatar-static
-             (account-avatar-static account))
+            (and (display-image?)
+                 (fetch-avatar-static
+                  (account-avatar-static account)))
             (account-to-string account)
             (creation-time->string time))
     (display-status (notification-status notification))))
@@ -254,8 +259,9 @@
       (cond
        (else
         (format port
-                "~s ~a ~a~@?~@?~@?~@?~@?~%~@?~@?"
-                (status-avatar-pict status/original)
+                "~@[~s ~]~a ~a~@?~@?~@?~@?~@?~%~@?~@?"
+                (and (display-image?)
+                     (status-avatar-pict status/original))
                 (account-to-string account)
                 (creation-time->string
                  (status-creation-time status/original))
@@ -284,15 +290,17 @@
                            (case (attachment-type att)
                              ((image)
                               (cond
-                               ((fetch-attachment-preview-pict att)
+                               (((and (display-image?)
+                                      (fetch-attachment-preview-pict att)))
                                 => identity)
                                (else
-                                "FAILED: IMAGE")))
+                                "MEDIA: IMAGE")))
                              (else
                               =>
                               (lambda (type)
-                                (format #f "UNSUPPORTED: ~:@(~a~)" type))))
-                           (format #f "NSFW: ~:@(~a~)" (attachment-type att))))
+                                (format #f "MEDIA: ~:@(~a~)" type))))
+                           (format #f "MEDIA: NSFW: ~:@(~a~)"
+                                   (attachment-type att))))
                      (status-media-attachments status))))))))
 
 (define (status-avatar-pict status)
@@ -465,7 +473,8 @@
                              ((emojis-ref emojis shortcode)
                               =>
                               (lambda (emoji)
-                                (or (fetch-emoji-pict emoji)
+                                (or (and (display-image?)
+                                         (fetch-emoji-pict emoji))
                                     shortcode))))
                             (loop (match:suffix mat))))))
                 (else