branch: elpa/mastodon
commit c14891151345abc20efb5669bbe209604c57450e
Merge: 40971e1f1f 66b14285e4
Author: marty hiatt <martianhia...@riseup.net>
Commit: marty hiatt <martianhia...@riseup.net>
Merge branch 'develop'
---
lisp/mastodon-http.el | 8 +-
lisp/mastodon-media.el | 157 ++++++++++++++++++-
lisp/mastodon-notifications.el | 2 +-
lisp/mastodon-profile.el | 38 +++--
lisp/mastodon-search.el | 20 ++-
lisp/mastodon-tl.el | 212 ++++++++++++++++---------
lisp/mastodon-toot.el | 348 +++++++++++++++++++++++++----------------
lisp/mastodon.el | 8 +-
mastodon-index.org | 3 +
9 files changed, 557 insertions(+), 239 deletions(-)
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index 60654ff5a6..d6abac4e15 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -187,9 +187,13 @@ PARAMS is an alist of any extra parameters to send with
the request.
SILENT means don't message.
NO-HEADERS means don't collect http response headers.
VECTOR means return json arrays as vectors."
- (let ((buf (mastodon-http--get url params silent)))
+(let ((buf (mastodon-http--get url params silent)))
+ ;; --get can return nil if instance unresponsive:
+ (if (not buf)
+ (user-error "Looks like the server response borked. \
+Is your instance up?")
(with-current-buffer buf
- (mastodon-http--process-response no-headers vector))))
+ (mastodon-http--process-response no-headers vector)))))
(defun mastodon-http--get-json (url &optional params silent vector)
"Return only JSON data from URL request.
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 3f6d0df026..d14d28340f 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -60,6 +60,10 @@
"Whether images should be cached."
:type 'boolean)
+(defcustom mastodon-media--hide-sensitive-media t
+ "Whether media marked as sensitive should be hidden."
+ :type 'boolean)
+
(defvar mastodon-media--generic-avatar-data
(base64-decode-string
"iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA
@@ -138,6 +142,136 @@
BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA
fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=")
"The PNG data for a generic 200x200 \"broken image\" view.")
+(defvar mastodon-media--sensitive-image-data
+ (base64-decode-string
+
"iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAA6npUWHRSYXcgcHJvZmlsZSB0eXBl
+IGV4aWYAAHjajVHbjcQwCPx3FVcCr/hRjvOSroMtfyc2Ts4rrXRIxjAQPEzC8fo9w89lkiXYknIs
+MRLMihWpCDJ1W5tnsuabbaPGMx7uggBS3NrTIo4fwBGz58X7efSPQSPgimh5CrU6vs746gMlfw5y
+Bsr9Zdr9Ax+k4oxsXi2WnKbV9o1my88xTRKXyMngTSilWBBnIUvQc7+InpuUNmjpgt7AyEergJMc
+ykrwqtZZ6nVMK+7YvAU0skMMb9qFJ/xKUADz4g9VusX8q82j0Rf7z1rhDfqGdxgpcULlAAABhWlD
+Q1BJQ0MgcHJvZmlsZQAAeJx9kT1Iw0AcxV8/tKJVBzuIOGSoTnZREd1qFYpQIdQKrTqYXPohNGlI
+UlwcBdeCgx+LVQcXZ10dXAVB8APE2cFJ0UVK/F9SaBHjwXE/3t173L0D/PUyU81gHFA1y0gnE0I2
+tyKEXtGJIHowgz6JmfqsKKbgOb7u4ePrXYxneZ/7c/QqeZMBPoE4znTDIl4nntq0dM77xBFWkhTi
+c+Ixgy5I/Mh12eU3zkWH/TwzYmTSc8QRYqHYxnIbs5KhEk8SRxVVo3x/1mWF8xZntVxlzXvyF4bz
+2vIS12kOI4kFLEKEABlVbKAMCzFaNVJMpGk/4eEfcvwiuWRybYCRYx4VqJAcP/gf/O7WLEyMu0nh
+BNDxYtsfI0BoF2jUbPv72LYbJ0DgGbjSWv5KHZj+JL3W0qJHQP82cHHd0uQ94HIHGHzSJUNypABN
+f6EAvJ/RN+WAgVuge9XtrbmP0wcgQ12lboCDQ2C0SNlrHu/uau/t3zPN/n4Ag31yra/8+kkAAA14
+aVRYdFhNTDpjb20uYWRvYmUueG1wAAAAAAA8P3hwYWNrZXQgYmVnaW49Iu+7vyIgaWQ9Ilc1TTBN
+cENlaGlIenJlU3pOVGN6a2M5ZCI/Pgo8eDp4bXBtZXRhIHhtbG5zOng9ImFkb2JlOm5zOm1ldGEv
+IiB4OnhtcHRrPSJYTVAgQ29yZSA0LjQuMC1FeGl2MiI+CiA8cmRmOlJERiB4bWxuczpyZGY9Imh0
+dHA6Ly93d3cudzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogIDxyZGY6RGVzY3Jp
+cHRpb24gcmRmOmFib3V0PSIiCiAgICB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94
+YXAvMS4wL21tLyIKICAgIHhtbG5zOnN0RXZ0PSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv
+c1R5cGUvUmVzb3VyY2VFdmVudCMiCiAgICB4bWxuczpkYz0iaHR0cDovL3B1cmwub3JnL2RjL2Vs
+ZW1lbnRzLzEuMS8iCiAgICB4bWxuczpHSU1QPSJodHRwOi8vd3d3LmdpbXAub3JnL3htcC8iCiAg
+ICB4bWxuczp0aWZmPSJodHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyIKICAgIHhtbG5zOnht
+cD0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wLyIKICAgeG1wTU06RG9jdW1lbnRJRD0iZ2lt
+cDpkb2NpZDpnaW1wOmYyYjU4MzUwLTc3ZWMtNDAxNC1hNDVlLTE1N2QyZjljOGM5NyIKICAgeG1w
+TU06SW5zdGFuY2VJRD0ieG1wLmlpZDowOTk5MzZhMi1jOGM5LTRkYTAtYTI0Yi02YTM1MmUyNmNi
+NmUiCiAgIHhtcE1NOk9yaWdpbmFsRG9jdW1lbnRJRD0ieG1wLmRpZDphMDliYmZhMi03MzA2LTQ3
+NWQtOGExNC05YzA3ZTE1NmFiMTYiCiAgIGRjOkZvcm1hdD0iaW1hZ2UvcG5nIgogICBHSU1QOkFQ
+ST0iMi4wIgogICBHSU1QOlBsYXRmb3JtPSJMaW51eCIKICAgR0lNUDpUaW1lU3RhbXA9IjE3MTc1
+MDI1MDIzNDQ1NzIiCiAgIEdJTVA6VmVyc2lvbj0iMi4xMC4zNCIKICAgdGlmZjpPcmllbnRhdGlv
+bj0iMSIKICAgeG1wOkNyZWF0b3JUb29sPSJHSU1QIDIuMTAiCiAgIHhtcDpNZXRhZGF0YURhdGU9
+IjIwMjQ6MDY6MDRUMTQ6MDE6NDArMDI6MDAiCiAgIHhtcDpNb2RpZnlEYXRlPSIyMDI0OjA2OjA0
+VDE0OjAxOjQwKzAyOjAwIj4KICAgPHhtcE1NOkhpc3Rvcnk+CiAgICA8cmRmOlNlcT4KICAgICA8
+cmRmOmxpCiAgICAgIHN0RXZ0OmFjdGlvbj0ic2F2ZWQiCiAgICAgIHN0RXZ0OmNoYW5nZWQ9Ii8i
+CiAgICAgIHN0RXZ0Omluc3RhbmNlSUQ9InhtcC5paWQ6NTRmM2I5NDktOTlkMS00Mzk2LWI2NzIt
+Y2ZkYjRlZWFiYTA1IgogICAgICBzdEV2dDpzb2Z0d2FyZUFnZW50PSJHaW1wIDIuMTAgKExpbnV4
+KSIKICAgICAgc3RFdnQ6d2hlbj0iMjAyNC0wNi0wNFQxNDowMTo0MiswMjowMCIvPgogICAgPC9y
+ZGY6U2VxPgogICA8L3htcE1NOkhpc3Rvcnk+CiAgPC9yZGY6RGVzY3JpcHRpb24+CiA8L3JkZjpS
+REY+CjwveDp4bXBtZXRhPgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgCjw/eHBhY2tldCBlbmQ9InciPz6w3d0DAAAABmJLR0QA/wD/AP+gvaeTAAAA
+CXBIWXMAAC4jAAAuIwF4pT92AAAAB3RJTUUH6AYEDAEq/VtQSwAAABl0RVh0Q29tbWVudABDcmVh
+dGVkIHdpdGggR0lNUFeBDhcAAAtOSURBVHja7dvbT5R3Hsfxz5xwhtOsjkgFGQZRTlFOCjJSkpVe
+YFltmpZNuo3t9qLdu/4Pa/+L3jVZL9pEU2q7aGirEkUkWw+IM5SpOELxgICcUXjmsBfKBOooo2Za
+3H2/Ei+EeRif74/3c5gnmj47fDgqAHGZGQFAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEI
+BCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgEAAAgEIBCAQgEAAAgFA
+IACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEIBCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAjw
+CrIm+w0ikYiCwaB8Pp8GBweVk5OjoqIiOZ1OjY+Pq6qq6g8fwuLiov7d1qbFhQUdOHhQaampSd0O
+BBLT2dmp8+fP6/3331dzc7Oi0ahu3bql1tZW7dixY00MIRqNKhQKyWyxyPQ7bAcCkSSNjY3p7Nmz
+anzjDeXl5cW+7vF41NLSos7OzjUxhHXr1umvLS2/23bgHkSSNDk5+ahC65Md5uTkaMuyaID/u0BS
+UlIkSd0XLmhubu6J73vr6tb8gO7fv69gMMhvyhqfV7LeN6mBZGdnKysrS1NTU2r95htNTU29Uou9
+uLiojo4OhUIhfvPX8LyS+b6mzw4fjibzHz8+Pq6jx45pfGxMqamp+suBA9pWWCiTKf5tbSgU0vXr
+1+X3+3Xnzh1t2bJFFRUV8ng8kqSBgQF99dVXkiTXxo36xyefaGBgQD6/X0ODg8rNzVVdXZ1ycnJW
+DNDn86nv55/1YH5excXF8nq9slgsikajmpiY0PDwsPx+v5qbm5WZmamJiQmdOHlSN4NB2Ww2paWn
+a252Vk1NTSovL3/qdsePH1dfX5/WrVsnm82mSCSiAwcOqKCgQF1dXeru7pbNZpNhGCoqKlJzc3NC
++53oJW0gEND1gQGNjY4qNzdXZWVlKikpic07EolocHBQgUBAwWBQVqtVnoICFW3frry8vNjrnnfO
+q80rWeub6Pu+KMu+ffv+mcxAUlNTVVxUpLm5Od2+fVt+n0/z8/PavHlz7BJsiWEYOnXqlDwej6qr
+q1VVVaUHDx+qtbVVm7KztdHlktPp1I4dOxQIBDQ5OSmTySSXy6Vd1dWqrKxU8OZNnTl9Wrt27Yrd
++5w5c0YOh0NvNDYqPz9f7e3tqq6ultVq1YMHD+T3+3X+/HmNjIyourpaDodDDodDmzZt0uXLl/XO
+O+9o//79qq+vV3Z2tiQ9dbvCwkLl5ubqypUrcjqd+vjjj+VyuSRJW7ZsUVlZmX755Rft3r1bDQ0N
+MpvNCe33avoDAXV0dKi2pkY1u3erpLRU83Nz8vv9Ki4ultVq1eLiotrb2zU8PKz6+nrt3btXZWVl
+j87wra0yDENut1tms/m557zavJK1vom875q9xFqSkZGhgwcP6t1335XdbtelS5f0xRdf6N69eyte
+19PTo/T0dL322muyWCxKSUlRdVWVcnJzdaKtTXNzc7JYLHK5XMrKypLNZtOePXvkdrtjw6qsqJBh
+GLo3Oho7e3R3dys9I0MWi0UbN25UQ0ODotFoLOC6ujo1NDQ8eXp9fDQ1m81xw4+3ndVqVWFhocrL
+y3Xv3r0V914mk0l2u102m01VVVWyWCwJ7/ezDA0N6djRo3pz/365XC6ZzWb9yenU66+/rg8++EB2
+u12SdOHCBQUCATU1NWnDhg2yWCxKTU1VbW2tGhsb1d3drf/89NOjI+dzznm1eSVrfRN53zX7Me+K
+Es1mFRcXKycnR6dOnZLP59OXX36pjz76SJmZmVpYWNCPP/6ocDisjo6OuD/jRjConY+fnVgsltiQ
+l3M4HLEj/NLrsrOz9e3x42ppaZHb7Y77cNJifbFRPG276upqXb16VYFAQLW1tbGvDwwMaE9dXezs
+9rz7/VuRSEQ//PCDamtrtWHDhqf+O2dmZnTu3DnVeb1KS0t74vuVlZU6e/asTp86pfKdO2OvSXTO
+q0nW+ibb7xbI8rNJc3OzZDLJd+2aenp61NDQoKmpKYXDYR06dEhut1vRaDR2lF86SjztviXeUT8S
+DscG/fbbb+vosWM6cuSIvF6v9uzZo9QkP/XevHmztm/fro6ODu0sL5fDblcoFNJPFy/qb++9F3vd
+y+735OSk7t69q5plEcaz9AFJZkZG3O/b7Xbt2LlTly9d0vT0dNyInjXn1SRrfV/pj3mnp6cViUSe
++LrNZtNer1eS1HvtWuz6dPkATCaTzGZz7E8iw5MUG/ryZy8ul0t///BD7WtsVFdXl/515IhmZmaS
+OliTyaSamhoZhqEbAwOxS6GqykrZbLYV1+Uvs98PHz58tJAJzmd2dvbpB6/09IT3L96cnyWZ6/vK
+BjI4NPTEfcaStMeLsbQo6x5fJ48uu7Z8EeHHR5blv4ThcFh2u13eujodOnRI42Njunr1asI/MxJ9
+sQ/68vLylJObq3OdnVpcXNTFixe1bdu2Fa952f1eugQZGxt75uucTuejA1Jvb+yXNd6zBEnKzMx8
+oTk/a17JXN+XXac/LJBUh0NdXV1xP58ef7ygFRUVkqQN69fLnZ+vzs7OuEe5Bw8famJiYsXfw3FO
+s4uLiyuOMAsLC7p0+XLs+263W6VlZU9su3SmW37aX7qJfjA/v+KsuPw18bZbvv1er1fjY2P6/vvv
+lZ+fH7uGXvK8+/1b69ev1+acHHV2dsZ9znT37l3Nzs4qIyND9fX1mpmZkc/ni3updu3aNf15374V
+l1eJznm1eSVrfRNdpzUZSHp6uvr6+vTtd99pZGREoVBIhmFoeHhYJ0+eVEVFhUpLS2M38fubmhQO
+h/XN8eMaGRlROBxWKBTSnTt3dDMYjB0FZ2ZmNPzrrzIMY8WlkmEYGhwcjIURjUZltVp15vRp3b59
+W5FIRGNjYxq8eVNFRUUrbiBHRkZig10KOjMzU66NG+Xz+zU/P6/Z2Vn19vauut1yHo9HTqdTPT09
+KikpifvhRaL7HfdDAotFb+7fL5vNphMnTmh0dFSRSESGYSgYDOr+/ftKf3yW9nq9qqysVFtbm65c
+uRL7JRwdHVXbiRPaXVOj2pqaFTf2ic55tXkla30TWac1+6BwYWFBP/f3y5mZqVu3bmngxg3NTE/L
+4/GoqLhYWwsKYvUvL7+3t1d9fX2ypaRoa0GBSkpKlJWVJUnq6+vT119/vWKbt956S263W59//nns
+5xmGIYfDoU8//VTt7e1KS0tTf3+/srKytGvXLuXm5kqSgsGg2tralJKSonA4LMMw5PF4dPDgwUeX
+LuPjOt/ZqZGREe0sL1d1VZVSUlJW3W45n9+vyYkJ1dfXP/N+7Vn7vZqJiQn19vaqv79fZrNZhYWF
+Ki0tfeJ5QCQS0dDQkAKBgG7cuCFJ2rp1q4qKimLPQF50ziaT6anzSub6JvK+a/ZJejIsfQKy/IYP
+/ztzXkvra30VFy7RjwTxas55La0v/+UWIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQ
+CEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCA
+QAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCA
+QAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEA
+BAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAQgEAIEABAIQCEAgAIEABAIQCEAgAIEA
+IBCAQICX9F8/bNVInwJ8BAAAAABJRU5ErkJggg==")
+ "The PNG data for a sensitive image placeholder.")
+
(defun mastodon-media--process-image-response
(status-plist marker image-options region-length url)
"Callback function processing the url retrieve response for URL.
@@ -173,12 +307,30 @@ with the image."
;; We only set the image to display if we could load
;; it; we already have set a default image when we
;; added the tag.
- (put-text-property marker (+ marker region-length)
- 'display image))
+ (mastodon-media--display-image-or-sensitive marker
region-length image))
;; We are done with the marker; release it:
(set-marker marker nil)))
(kill-buffer url-buffer))))))
+(defun mastodon-media--display-image-or-sensitive (marker region-length image)
+ "Display image using display property, or add sensitive mask.
+MARKER, REGION-LENGTH and IMAGE are from
+`mastodon-media--process-image-response'.
+If the image is marked sensitive, the image is stored in
+image-data prop so it can be toggled."
+ (if (or (not (equal t (get-text-property marker 'sensitive)))
+ (not mastodon-media--hide-sensitive-media))
+ ;; display image
+ (put-text-property marker (+ marker region-length)
+ 'display image)
+ ;; display sensitive placeholder and save image data as prop:
+ (add-text-properties marker (+ marker region-length)
+ `(display
+ ;; (image :type png :data
,mastodon-media--sensitive-image-data)
+ ,(create-image mastodon-media--sensitive-image-data
nil t)
+ sensitive-state hidden
+ image-data ,image))))
+
(defun mastodon-media--process-full-sized-image-response (status-plist url)
;; FIXME: refactor this with but not into
;; `mastodon-media--process-image-response'.
@@ -295,7 +447,6 @@ Replace them with the referenced image."
(put-text-property start end 'media-state 'invalid-url)
;; proceed to load this image asynchronously
(put-text-property start end 'media-state 'loading)
- ;; TODO: only load-image if not sensitive:
(mastodon-media--load-image-from-url
image-url media-type start (- end start))
(when (or (equal type "gifv")
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index c26d0b01b9..58068932a9 100644
--- a/lisp/mastodon-notifications.el
+++ b/lisp/mastodon-notifications.el
@@ -261,7 +261,7 @@ Status notifications are given when
(equal type 'follow-request)
(equal type 'mention))
'mastodon-tl--byline-author
- (lambda (_status &rest args) ; unbreak stuff
+ (lambda (_status &rest _args) ; unbreak stuff
(mastodon-tl--byline-author note)))
;; action-byline
(lambda (_status)
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 46a56f6ec5..de16b7d216 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -146,15 +146,16 @@ This variable is set from data in
(mastodon-tl--property 'item-json))
(defun mastodon-profile--make-author-buffer
- (account &optional no-reblogs no-replies only-media tag)
+ (account &optional no-reblogs no-replies only-media tag max-id)
"Take an ACCOUNT json and insert a user account into a new buffer.
NO-REBLOGS means do not display boosts in statuses.
NO-REPLIES means to exlude replies.
ONLY-MEDIA means show only posts containing attachments.
-TAG is a hashtag to restrict posts to."
+TAG is a hashtag to restrict posts to.
+MAX-ID is a flag to include the max_id pagination parameter."
(mastodon-profile--make-profile-buffer-for
account "statuses" #'mastodon-tl--timeline no-reblogs nil
- no-replies only-media tag))
+ no-replies only-media tag max-id))
;; TODO: we shd just load all views' data then switch coz this is slow af:
(defun mastodon-profile--account-view-cycle ()
@@ -572,7 +573,11 @@ FIELDS means provide a fields vector fetched by other
means."
(defun mastodon-profile--insert-statuses-pinned (pinned-statuses)
"Insert each of the PINNED-STATUSES for a given account."
(mapc (lambda (pinned-status)
- (insert (mastodon-tl--set-face " :pinned: " 'success))
+ (insert
+ (concat " "
+ (propertize " pinned "
+ 'face '(:inherit success :box t))
+ " "))
(mastodon-tl--toot pinned-status))
pinned-statuses))
@@ -594,15 +599,20 @@ FIELDS means provide a fields vector fetched by other
means."
(defun mastodon-profile--make-profile-buffer-for
(account endpoint-type update-function
- &optional no-reblogs headers no-replies only-media tag)
+ &optional no-reblogs headers no-replies only-media tag max-id)
"Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION.
NO-REBLOGS means do not display boosts in statuses.
HEADERS means also fetch link headers for pagination.
NO-REPLIES means to exlude replies.
ONLY-MEDIA means show only posts containing attachments.
-TAG is a hashtag to restrict posts to."
+TAG is a hashtag to restrict posts to.
+MAX-ID is a flag to include the max_id pagination parameter."
(let-alist account
- (let* ((args `(("limit" . ,mastodon-tl--timeline-posts-count)))
+ (let* ((max-id-str (when max-id
+ (mastodon-tl--buffer-property 'max-id)))
+ (args `(("limit" . ,mastodon-tl--timeline-posts-count)
+ ,(when max-id
+ `("max_id" . ,max-id-str))))
(args (cond (no-reblogs
(push '("exclude_reblogs" . "t") args))
(no-replies
@@ -635,11 +645,9 @@ TAG is a hashtag to restrict posts to."
(relationships (mastodon-profile--relationships-get .id)))
(with-mastodon-buffer buffer #'mastodon-mode nil
(mastodon-profile-mode)
- (remove-overlays)
(setq mastodon-profile--account account)
- (mastodon-tl--set-buffer-spec buffer endpoint
- update-function link-header
- args)
+ (mastodon-tl--set-buffer-spec buffer endpoint update-function
+ link-header args nil max-id-str)
(let* ((inhibit-read-only t)
(is-statuses (string= endpoint-type "statuses"))
(is-followers (string= endpoint-type "followers"))
@@ -748,12 +756,14 @@ the format \"2000-01-31T00:00:00.000Z\"."
(format-time-string "Joined: %d %B %Y"
(parse-iso8601-time-string joined)))
-(defun mastodon-profile--get-toot-author ()
+(defun mastodon-profile--get-toot-author (&optional max-id)
"Open profile of author of toot under point.
-If toot is a boost, opens the profile of the booster."
+If toot is a boost, opens the profile of the booster.
+MAX-ID is a flag to include the max_id pagination parameter."
(interactive)
(mastodon-profile--make-author-buffer
- (alist-get 'account (mastodon-profile--item-json))))
+ (alist-get 'account (mastodon-profile--item-json))
+ nil nil nil nil max-id))
(defun mastodon-profile--image-from-account (account img-type)
"Return a avatar image from ACCOUNT.
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index d73bf9ff62..e69366e692 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -122,15 +122,21 @@ PRINT-FUN is the function used to print the data from the
response."
;; functions for mastodon search
-(defun mastodon-search--insert-heading (heading &optional type)
- "Format HEADING as a heading.
+(defun mastodon-search--insert-heading (str &optional type)
+ "Insert STR as a heading.
Optionally add string TYPE after HEADING."
(insert
- (mastodon-tl--set-face (concat "\n " mastodon-tl--horiz-bar "\n "
- (upcase heading) " "
- (if type (upcase type) "") "\n"
- " " mastodon-tl--horiz-bar "\n")
- 'success)))
+ (mastodon-search--format-heading str type)))
+
+(defun mastodon-search--format-heading (str &optional type)
+ "Format STR as a heading.
+Optionally add string TYPE after HEADING."
+ (mastodon-tl--set-face
+ (concat "\n " mastodon-tl--horiz-bar "\n "
+ (upcase str) " "
+ (if type (upcase type) "") "\n"
+ " " mastodon-tl--horiz-bar "\n")
+ 'success))
(defvar mastodon-search-types
'("statuses" "accounts" "hashtags"))
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index aa70507119..41ecd8529f 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -100,6 +100,7 @@
(defvar mastodon-toot-timestamp-format)
(defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this
(defvar mastodon-media--enable-image-caching)
+(defvar mastodon-media--generic-broken-image-data)
(defvar mastodon-mode-map)
@@ -292,6 +293,7 @@ types of mastodon links and not just shr.el-generated
ones.")
;; keep new my-profile binding; shr 'O' doesn't work here anyway
(define-key map (kbd "O") #'mastodon-profile--my-profile)
(define-key map (kbd "C") #'mastodon-tl--copy-image-caption)
+ (define-key map (kbd "S") #'mastodon-tl--toggle-sensitive-image)
(define-key map (kbd "<C-return>") #'mastodon-tl--mpv-play-video-at-point)
(define-key map (kbd "<mouse-2>") #'mastodon-tl--click-image-or-video)
map)
@@ -322,10 +324,12 @@ than `pop-to-buffer'."
(let ((inhibit-read-only t))
(erase-buffer)
(funcall ,mode-fun)
+ (remove-overlays) ; video overlays
+ ,@body
+ ;; return result of switching buffer:
(if ,other-window
(switch-to-buffer-other-window ,buffer)
- (pop-to-buffer ,buffer '(display-buffer-same-window)))
- ,@body)))
+ (pop-to-buffer ,buffer '(display-buffer-same-window))))))
(defmacro mastodon-tl--do-if-item (&rest body)
"Execute BODY if we have an item at point."
@@ -442,7 +446,7 @@ Used on initializing a timeline or thread."
;;; TIMELINES
-(defun mastodon-tl--get-federated-timeline (&optional prefix local)
+(defun mastodon-tl--get-federated-timeline (&optional prefix local max-id)
"Open federated timeline.
If LOCAL, get only local timeline.
With a single PREFIX arg, hide-replies.
@@ -454,20 +458,28 @@ With a double PREFIX arg, only show posts with media."
(push '("only_media" . "true") params))
(when local
(push '("local" . "true") params))
+ (when max-id
+ (push `("max_id" . ,(mastodon-tl--buffer-property 'max-id))
+ params))
(message "Loading federated timeline...")
(mastodon-tl--init (if local "local" "federated")
"timelines/public" 'mastodon-tl--timeline nil
params
(when (eq prefix 4) t))))
-(defun mastodon-tl--get-home-timeline (&optional arg)
+(defun mastodon-tl--get-home-timeline (&optional arg max-id)
"Open home timeline.
-With a single prefix ARG, hide replies."
+With a single prefix ARG, hide replies.
+MAX-ID is a flag to add the max_id pagination parameter."
(interactive "p")
- (message "Loading home timeline...")
- (mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil
- `(("limit" . ,mastodon-tl--timeline-posts-count))
- (when (eq arg 4) t)))
+ (let* ((params
+ `(("limit" . ,mastodon-tl--timeline-posts-count)
+ ,(when max-id
+ `("max_id" . ,(mastodon-tl--buffer-property 'max-id))))))
+ (message "Loading home timeline...")
+ (mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil
+ params
+ (when (eq arg 4) t))))
(defun mastodon-tl--get-remote-local-timeline ()
"Prompt for an instance domain and try to display its local timeline.
@@ -506,13 +518,14 @@ Use this to re-load remote-local items in order to
interact with them."
(uri (mastodon-tl--field 'uri toot)))
(mastodon-url-lookup uri))))
-(defun mastodon-tl--get-local-timeline (&optional prefix)
+(defun mastodon-tl--get-local-timeline (&optional prefix max-id)
"Open local timeline.
With a single PREFIX arg, hide-replies.
-With a double PREFIX arg, only show posts with media."
+With a double PREFIX arg, only show posts with media.
+MAX-ID is a flag to add the max_id pagination parameter."
(interactive "p")
(message "Loading local timeline...")
- (mastodon-tl--get-federated-timeline prefix :local))
+ (mastodon-tl--get-federated-timeline prefix :local max-id))
(defun mastodon-tl--get-tag-timeline (&optional prefix tag)
"Prompt for tag and opens its timeline.
@@ -558,10 +571,10 @@ Do so if type of status at poins is not
follow_request/follow."
(let ((type (alist-get 'type
(mastodon-tl--property 'item-json :no-move)))
(echo (mastodon-tl--property 'help-echo :no-move)))
- (when echo ; not for followers/following in profile
+ (when (not (equal "" echo)) ; not for followers/following in profile
(unless (or (string= type "follow_request")
(string= type "follow")) ; no counts for these
- (message "%s" (mastodon-tl--property 'help-echo :no-move))))))
+ (message "%s" echo)))))
(defun mastodon-tl--byline-author (toot &optional avatar domain)
"Propertize author of TOOT.
@@ -1206,37 +1219,56 @@ SENSITIVE is a flag from the item's JSON data."
(url-retrieve url #'mastodon-media--process-full-sized-image-response
`(,url)))))))
+(defvar mastodon-media--sensitive-image-data)
+
+(defun mastodon-tl--toggle-sensitive-image ()
+ "Toggle dislay of sensitive image at point."
+ (interactive)
+ (if (not (eq t (mastodon-tl--property 'sensitive)))
+ (user-error "No sensitive media at point?")
+ (let ((data (mastodon-tl--property 'image-data :no-move))
+ (inhibit-read-only t)
+ (end (next-single-property-change (point) 'sensitive-state)))
+ (if (equal 'hidden (mastodon-tl--property 'sensitive-state :no-move))
+ ;; display sensitive image:
+ (add-text-properties (point) end
+ `(display ,data
+ sensitive-state showing))
+ ;; hide sensitive image:
+ (add-text-properties (point) end
+ `( sensitive-state hidden
+ display
+ ,(create-image
+ mastodon-media--sensitive-image-data nil
t)))))))
+
;; POLLS
-(defun mastodon-tl--format-poll-option (option option-counter longest-option)
+(defun mastodon-tl--format-poll-option (option option-counter length)
"Format poll OPTION. OPTION-COUNTER is just a counter.
-LONGEST-OPTION is the option whose length determines the formatting."
+LENGTH is of the longest option, for formatting."
(format "%s: %s%s%s\n"
option-counter
(propertize (alist-get 'title option)
'face 'success)
- (make-string (1+ (- (length longest-option)
+ (make-string (1+ (- length
(length (alist-get 'title option))))
?\ )
;; TODO: disambiguate no votes from hidden votes
(format "[%s votes]" (or (alist-get 'votes_count option)
"0"))))
-(defun mastodon-tl--get-poll (toot)
- "If TOOT includes a poll, return it as a formatted string."
- (let-alist (mastodon-tl--field 'poll toot) ; toot or reblog
+(defun mastodon-tl--format-poll (poll)
+ "From json poll data POLL, return a display string."
+ (let-alist poll
(let* ((option-titles (mastodon-tl--map-alist 'title .options))
- (longest-option (car (sort option-titles
- (lambda (x y)
- (> (length x)
- (length y))))))
+ (longest (car (sort (mapcar #'length option-titles) #'>)))
(option-counter 0))
(concat "\nPoll: \n\n"
(mapconcat (lambda (option)
(setq option-counter (1+ option-counter))
(mastodon-tl--format-poll-option
- option option-counter longest-option))
+ option option-counter longest))
.options
"\n")
"\n"
@@ -1445,7 +1477,8 @@ Runs `mastodon-tl--render-text' and fetches poll or
media."
(media-p (mastodon-tl--field 'media_attachments toot)))
(concat (mastodon-tl--render-text content toot)
(when poll-p
- (mastodon-tl--get-poll toot))
+ (mastodon-tl--format-poll
+ (mastodon-tl--field 'poll toot))) ;; toot or reblog
(when media-p
(mastodon-tl--media toot)))))
@@ -1657,13 +1690,15 @@ If NO-ERROR is non-nil, do not error when property is
empty."
property)))))
(defun mastodon-tl--set-buffer-spec
- (buffer endpoint update-fun &optional link-header update-params
hide-replies)
+ (buffer endpoint update-fun
+ &optional link-header update-params hide-replies max-id)
"Set `mastodon-tl--buffer-spec' for the current buffer.
BUFFER is buffer name, ENDPOINT is buffer's enpoint,
UPDATE-FUN is its update function.
LINK-HEADER is the http Link header if present.
UPDATE-PARAMS is any http parameters needed for the update function.
-HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer."
+HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer.
+MAX-ID is the pagination parameter."
(setq mastodon-tl--buffer-spec
`(account ,(cons mastodon-active-user
mastodon-instance-url)
@@ -1672,7 +1707,8 @@ HIDE-REPLIES is a flag indicating if replies are hidden
in the current buffer."
update-function ,update-fun
link-header ,link-header
update-params ,update-params
- hide-replies ,hide-replies)))
+ hide-replies ,hide-replies
+ max-id ,max-id)))
;;; BUFFERS
@@ -1819,20 +1855,20 @@ timeline."
;;; UTILITIES
-(defun mastodon-tl--map-alist (key alist)
- "Return a list of values extracted from ALIST with KEY.
-Key is a symbol, as with `alist-get'."
- (mapcar (lambda (x)
- (alist-get key x))
- alist))
+(defun mastodon-tl--map-alist (key alists &optional testfn)
+ "Return a list of values extracted from ALISTS with KEY.
+Key is a symbol, as with `alist-get', or else compatible with TESTFN.
+ALISTS is a list of alists."
+ ;; this actually for a list of alists, right? so change the arg?
+ (cl-loop for x in alists
+ collect (alist-get key x nil nil testfn)))
(defun mastodon-tl--map-alist-vals-to-alist (key1 key2 alist)
"From ALIST, return an alist consisting of (val1 . val2) elements.
Values are accessed by `alist-get', using KEY1 and KEY2."
- (mapcar (lambda (x)
- (cons (alist-get key1 x)
- (alist-get key2 x)))
- alist))
+ (cl-loop for x in alist
+ collect (cons (alist-get key1 x)
+ (alist-get key2 x))))
(defun mastodon-tl--symbol (name)
"Return the unicode symbol (as a string) corresponding to NAME.
@@ -1969,7 +2005,6 @@ view all branches of a thread."
;; if we have a thread:
(with-mastodon-buffer buffer #'mastodon-mode nil
(let ((marker (make-marker)))
- (remove-overlays) ; video overlays
(mastodon-tl--set-buffer-spec buffer endpoint
#'mastodon-tl--thread)
(mastodon-tl--timeline (alist-get 'ancestors context)
:thread)
@@ -2321,12 +2356,10 @@ ARGS is an alist of any parameters to send with the
request."
(let* ((toot (or (mastodon-tl--property 'base-toot :no-move) ; fave/boost
notifs
(mastodon-tl--property 'item-json :no-move)))
(tags (mastodon-tl--field 'tags toot)))
- (mapcar (lambda (x)
- (alist-get 'name x))
- tags)))
+ (mastodon-tl--map-alist 'name tags)))
(defun mastodon-tl--follow-tag (&optional tag)
- "Prompt for a tag and follow it.
+ "Prompt for a tag (from post at point) and follow it.
If TAG provided, follow it."
(interactive)
(let* ((tags (unless tag (mastodon-tl--get-tags-list)))
@@ -2542,22 +2575,27 @@ the current view."
(defun mastodon-tl--reload-timeline-or-profile (&optional pos)
"Reload the current timeline or profile page.
For use after e.g. deleting a toot.
-POS is a number, where point will be placed."
- (let ((type (mastodon-tl--get-buffer-type)))
+POS is a number, where point will be placed.
+Aims to respect any pagination in effect."
+ (let ((type (mastodon-tl--get-buffer-type))
+ (max-id (mastodon-tl--buffer-property 'max-id nil :no-error)))
(cond ((eq type 'home)
- (mastodon-tl--get-home-timeline))
+ (mastodon-tl--get-home-timeline nil max-id))
((eq type 'federated)
- (mastodon-tl--get-federated-timeline))
+ (mastodon-tl--get-federated-timeline nil nil max-id))
((eq type 'local)
- (mastodon-tl--get-local-timeline))
+ (mastodon-tl--get-local-timeline nil max-id))
((eq type 'mentions)
(mastodon-notifications--get-mentions))
((eq type 'notifications)
- (mastodon-notifications-get nil nil :force))
+ (mastodon-notifications-get nil nil :force max-id))
((eq type 'profile-statuses-no-boosts)
+ ;; TODO: max-id arg needed here also
(mastodon-profile--open-statuses-no-reblogs))
((eq type 'profile-statuses)
- (mastodon-profile--my-profile))
+ (save-excursion
+ (goto-char (point-min))
+ (mastodon-profile--get-toot-author max-id)))
((eq type 'thread)
(save-match-data
(let ((endpoint (mastodon-tl--endpoint)))
@@ -2622,17 +2660,19 @@ and profile pages when showing followers or accounts
followed."
(mastodon-tl--update-params)
'mastodon-tl--more* (current-buffer) (point)))
(t;; max_id paginate (timelines, items with ids/timestamps):
- (mastodon-tl--more-json-async
- (mastodon-tl--endpoint)
- (mastodon-tl--oldest-id)
- (mastodon-tl--update-params)
- 'mastodon-tl--more* (current-buffer) (point))))))
-
-(defun mastodon-tl--more* (response buffer point-before &optional headers)
+ (let ((max-id (mastodon-tl--oldest-id)))
+ (mastodon-tl--more-json-async
+ (mastodon-tl--endpoint)
+ max-id
+ (mastodon-tl--update-params)
+ 'mastodon-tl--more* (current-buffer) (point) nil max-id))))))
+
+(defun mastodon-tl--more* (response buffer point-before &optional headers
max-id)
"Append older toots to timeline, asynchronously.
Runs the timeline's update function on RESPONSE, in BUFFER.
When done, places point at POINT-BEFORE.
-HEADERS is the http headers returned in the response, if any."
+HEADERS is the http headers returned in the response, if any.
+MAX-ID is the pagination parameter, a string."
(with-current-buffer buffer
(if (not response)
(message "No more results")
@@ -2663,13 +2703,13 @@ HEADERS is the http headers returned in the response,
if any."
(message "No more results.")
(funcall (mastodon-tl--update-function) json)
(goto-char point-before)
- ;; update buffer spec to new link-header:
+ ;; update buffer spec to new link-header or max-id:
;; (other values should just remain as they were)
- (when headers
- (mastodon-tl--set-buffer-spec (mastodon-tl--buffer-name)
- (mastodon-tl--endpoint)
- (mastodon-tl--update-function)
- link-header))
+ (mastodon-tl--set-buffer-spec (mastodon-tl--buffer-name)
+ (mastodon-tl--endpoint)
+ (mastodon-tl--update-function)
+ link-header
+ nil nil max-id)
(message "Loading... done.")))))))
(defun mastodon-tl--find-property-range (property start-point
@@ -2918,13 +2958,15 @@ JSON and http headers, without it just the JSON."
(link-header (mastodon-tl--get-link-header-from-response
headers)))
(with-mastodon-buffer buffer #'mastodon-mode nil
(mastodon-tl--set-buffer-spec buffer endpoint update-function
- link-header update-params
hide-replies)
+ link-header update-params
hide-replies
+ ;; awful hack to fix multiple
reloads:
+ (alist-get "max_id" update-params
nil nil #'equal))
(mastodon-tl--do-init json update-function instance)))))))
- (defun mastodon-tl--init-sync
- (buffer-name endpoint update-function
- &optional note-type params headers view-name binding-str)
- "Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
+(defun mastodon-tl--init-sync
+ (buffer-name endpoint update-function
+ &optional note-type params headers view-name binding-str)
+ "Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
UPDATE-FUNCTION is used to receive more toots.
Runs synchronously.
Optional arg NOTE-TYPE means only get that type of notification.
@@ -2954,7 +2996,9 @@ BINDING-STR is a string explaining any bindins in the
view."
(insert (mastodon-tl--set-face (concat "[" binding-str "]\n\n")
'font-lock-comment-face)))
(mastodon-tl--set-buffer-spec buffer endpoint update-function
- link-header params)
+ link-header params nil
+ ;; awful hack to fix multiple reloads:
+ (alist-get "max_id" params nil nil
#'equal))
(mastodon-tl--do-init json update-function)
buffer)))
@@ -2983,5 +3027,31 @@ When DOMAIN, force inclusion of user's domain in their
handle."
(unless (mastodon-tl--profile-buffer-p)
(mastodon-tl--goto-first-item)))
+;;; BOOKMARKS
+
+(require 'bookmark)
+
+(defun mastodon-tl--bookmark-handler (record)
+ "Jump to a bookmarked location in mastodon.el.
+RECORD is the bookmark record."
+ (let ((id (bookmark-prop-get record 'id)))
+ ;; we need to handle thread and single toot for starters
+ (pop-to-buffer
+ (mastodon-tl--thread id))))
+
+(defun mastodon-tl--bookmark-make-record ()
+ "Return a bookmark record for the current mastodon buffer."
+ (let ((id (mastodon-tl--property 'item-id :no-move))
+ (name (buffer-name)))
+ `(,name
+ (buf . ,name)
+ (id . ,id)
+ (handler . mastodon-tl--bookmark-handler))))
+
+(add-hook 'mastodon-mode-hook
+ (lambda ()
+ (setq-local bookmark-make-record-function
+ #'mastodon-tl--bookmark-make-record)))
+
(provide 'mastodon-tl)
;;; mastodon-tl.el ends here
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 654918cc4c..23de8b7373 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -95,6 +95,8 @@
(autoload 'mastodon-tl--toot-or-base "mastodon-tl")
(autoload 'mastodon-profile--get-source-value "mastodon-toot")
(autoload 'mastodon-tl--get-buffer-type "mastodon-tl")
+(autoload 'mastodon-tl--human-duration "mastodon-tl")
+(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile")
;; for mastodon-toot--translate-toot-text
(autoload 'mastodon-tl--content "mastodon-tl")
@@ -279,6 +281,7 @@ send.")
(define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media)
(define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments)
(define-key map (kbd "C-c C-p") #'mastodon-toot--create-poll)
+ (define-key map (kbd "C-c C-o") #'mastodon-toot--clear-poll)
(define-key map (kbd "C-c C-l") #'mastodon-toot--set-toot-language)
(define-key map (kbd "C-c C-s") #'mastodon-toot--schedule-toot)
map)
@@ -362,61 +365,65 @@ boosting, or bookmarking toots."
"Toggle boost or favourite of toot at `point'.
TYPE is a symbol, either `favourite' or `boost.'"
(mastodon-tl--do-if-item-strict
- (let* ((boost-p (equal type 'boost))
- ;; (has-id (mastodon-tl--property 'base-item-id))
- (byline-region ;(when has-id
- (mastodon-tl--find-property-range 'byline (point)))
- (id (when byline-region
- (mastodon-tl--as-string (mastodon-tl--property
'base-item-id))))
- (boosted (when byline-region
- (get-text-property (car byline-region) 'boosted-p)))
- (faved (when byline-region
- (get-text-property (car byline-region) 'favourited-p)))
- (action (if boost-p
- (if boosted "unreblog" "reblog")
- (if faved "unfavourite" "favourite")))
- (msg (if boosted "unboosted" "boosted"))
- (action-string (if boost-p "boost" "favourite"))
- (remove (if boost-p (when boosted t) (when faved t)))
- (item-json (mastodon-tl--property 'item-json))
- (toot-type (alist-get 'type item-json))
- (visibility (mastodon-tl--field 'visibility item-json)))
- (if byline-region
- (if (and (or (equal visibility "direct")
- (equal visibility "private"))
- boost-p)
- (message "You cant boost posts with visibility: %s" visibility)
- (cond ;; actually there's nothing wrong with faving/boosting own
toots!
- ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'item-json))
- ;;(error "You can't %s your own toots" action-string))
- ;; & nothing wrong with faving/boosting own toots from notifs:
- ;; this boosts/faves the base toot, not the notif status
- ((and (equal "reblog" toot-type)
- (not (mastodon-tl--buffer-type-eq 'notifications)))
- (user-error "You can't %s boosts" action-string))
- ((and (equal "favourite" toot-type)
- (not (mastodon-tl--buffer-type-eq 'notifications)))
- (user-error "You can't %s favourites" action-string))
- ((and (equal "private" visibility)
- (equal type 'boost))
- (user-error "You can't boost private toots"))
- (t
- (mastodon-toot--action
- action
- (lambda (_)
- (let ((inhibit-read-only t))
- (add-text-properties (car byline-region)
- (cdr byline-region)
- (if boost-p
- (list 'boosted-p (not boosted))
- (list 'favourited-p (not faved))))
- (mastodon-toot--update-stats-on-action type remove)
- (mastodon-toot--action-success (if boost-p
- (mastodon-tl--symbol
'boost)
- (mastodon-tl--symbol
'favourite))
- byline-region remove))
- (message (format "%s #%s" (if boost-p msg action) id)))))))
- (message (format "Nothing to %s here?!?" action-string))))))
+ (let ((n-type (mastodon-tl--property 'notification-type :no-move)))
+ (if (or (equal n-type "follow")
+ (equal n-type "follow_request"))
+ (user-error (format "Can't do action on %s notifications." n-type))
+ (let* ((boost-p (equal type 'boost))
+ ;; (has-id (mastodon-tl--property 'base-item-id))
+ (byline-region ;(when has-id
+ (mastodon-tl--find-property-range 'byline (point)))
+ (id (when byline-region
+ (mastodon-tl--as-string (mastodon-tl--property
'base-item-id))))
+ (boosted (when byline-region
+ (get-text-property (car byline-region) 'boosted-p)))
+ (faved (when byline-region
+ (get-text-property (car byline-region) 'favourited-p)))
+ (action (if boost-p
+ (if boosted "unreblog" "reblog")
+ (if faved "unfavourite" "favourite")))
+ (msg (if boosted "unboosted" "boosted"))
+ (action-string (if boost-p "boost" "favourite"))
+ (remove (if boost-p (when boosted t) (when faved t)))
+ (item-json (mastodon-tl--property 'item-json))
+ (toot-type (alist-get 'type item-json))
+ (visibility (mastodon-tl--field 'visibility item-json)))
+ (if byline-region
+ (if (and (or (equal visibility "direct")
+ (equal visibility "private"))
+ boost-p)
+ (message "You cant boost posts with visibility: %s"
visibility)
+ (cond ;; actually there's nothing wrong with faving/boosting
own toots!
+ ;;((mastodon-toot--own-toot-p (mastodon-tl--property
'item-json))
+ ;;(error "You can't %s your own toots" action-string))
+ ;; & nothing wrong with faving/boosting own toots from notifs:
+ ;; this boosts/faves the base toot, not the notif status
+ ((and (equal "reblog" toot-type)
+ (not (mastodon-tl--buffer-type-eq 'notifications)))
+ (user-error "You can't %s boosts" action-string))
+ ((and (equal "favourite" toot-type)
+ (not (mastodon-tl--buffer-type-eq 'notifications)))
+ (user-error "You can't %s favourites" action-string))
+ ((and (equal "private" visibility)
+ (equal type 'boost))
+ (user-error "You can't boost private toots"))
+ (t
+ (mastodon-toot--action
+ action
+ (lambda (_)
+ (let ((inhibit-read-only t))
+ (add-text-properties (car byline-region)
+ (cdr byline-region)
+ (if boost-p
+ (list 'boosted-p (not boosted))
+ (list 'favourited-p (not faved))))
+ (mastodon-toot--update-stats-on-action type remove)
+ (mastodon-toot--action-success (if boost-p
+ (mastodon-tl--symbol
'boost)
+ (mastodon-tl--symbol
'favourite))
+ byline-region remove))
+ (message (format "%s #%s" (if boost-p msg action) id)))))))
+ (message (format "Nothing to %s here?!?" action-string))))))))
(defun mastodon-toot--inc-or-dec (count subtract)
"If SUBTRACT, decrement COUNT, else increment."
@@ -461,35 +468,39 @@ SUBTRACT means we are un-favouriting or unboosting, so we
decrement."
"Bookmark or unbookmark toot at point."
(interactive)
(mastodon-tl--do-if-item-strict
- (let* ((id (mastodon-tl--property 'base-item-id))
- (bookmarked-p
- (mastodon-tl--property
- 'bookmarked-p
- (if (mastodon-tl--property 'byline :no-move)
- ;; no move if not in byline, the idea being if in body, we do
- ;; move forward to byline to toggle correctly.
- ;; alternatively we could bookmarked-p whole posts.
- :no-move)))
- (byline-region (when id
- (mastodon-tl--find-property-range 'byline (point))))
- (action (if bookmarked-p "unbookmark" "bookmark"))
- (bookmark-str (mastodon-tl--symbol 'bookmark))
- (message (if bookmarked-p
- "Bookmark removed!"
- "Toot bookmarked!"))
- (remove (when bookmarked-p t)))
- (if byline-region
- (mastodon-toot--action
- action
- (lambda (_)
- (let ((inhibit-read-only t))
- (add-text-properties (car byline-region)
- (cdr byline-region)
- (list 'bookmarked-p (not bookmarked-p))))
- (mastodon-toot--action-success bookmark-str
- byline-region remove)
- (message (format "%s #%s" message id))))
- (message (format "Nothing to %s here?!?" action))))))
+ (let ((n-type (mastodon-tl--property 'notification-type :no-move)))
+ (if (or (equal n-type "follow")
+ (equal n-type "follow_request"))
+ (user-error (format "Can't do action on %s notifications." n-type))
+ (let* ((id (mastodon-tl--property 'base-item-id))
+ (bookmarked-p
+ (mastodon-tl--property
+ 'bookmarked-p
+ (if (mastodon-tl--property 'byline :no-move)
+ ;; no move if not in byline, the idea being if in body, we
do
+ ;; move forward to byline to toggle correctly.
+ ;; alternatively we could bookmarked-p whole posts.
+ :no-move)))
+ (byline-region (when id
+ (mastodon-tl--find-property-range 'byline
(point))))
+ (action (if bookmarked-p "unbookmark" "bookmark"))
+ (bookmark-str (mastodon-tl--symbol 'bookmark))
+ (message (if bookmarked-p
+ "Bookmark removed!"
+ "Toot bookmarked!"))
+ (remove (when bookmarked-p t)))
+ (if byline-region
+ (mastodon-toot--action
+ action
+ (lambda (_)
+ (let ((inhibit-read-only t))
+ (add-text-properties (car byline-region)
+ (cdr byline-region)
+ (list 'bookmarked-p (not
bookmarked-p))))
+ (mastodon-toot--action-success bookmark-str
+ byline-region remove)
+ (message (format "%s #%s" message id))))
+ (message (format "Nothing to %s here?!?" action))))))))
(defun mastodon-toot--list-toot-boosters ()
"List the boosters of toot at point."
@@ -677,7 +688,7 @@ MEDIA is the media_attachments data for a status from the
server."
media))
(defun mastodon-toot--set-toot-properties
- (reply-id visibility cw lang &optional scheduled scheduled-id media)
+ (reply-id visibility cw lang &optional scheduled scheduled-id media poll)
"Set the toot properties for the current redrafted or edited toot.
REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set.
MEDIA is the media_attachments data for a status from the server."
@@ -692,6 +703,8 @@ MEDIA is the media_attachments data for a status from the
server."
(mastodon-toot--set-cw cw)
(when media
(mastodon-toot--set-toot-media-attachments media))
+ (when poll
+ (mastodon-toot--server-poll-to-local poll))
(mastodon-toot--refresh-attachments-display)
(mastodon-toot--update-status-fields)))
@@ -906,6 +919,7 @@ instance to edit a toot."
(mastodon-http--triage
response
(lambda (_)
+ ;; kill buffer:
(mastodon-toot--kill)
(if scheduled
(message "Toot scheduled!")
@@ -914,6 +928,7 @@ instance to edit a toot."
(when scheduled-id
(mastodon-views--cancel-scheduled-toot
scheduled-id :no-confirm))
+ ;; window config:
(mastodon-toot--restore-previous-window-config
prev-window-config)
;; reload previous view in certain cases:
;; we reload: - when we have been editing
@@ -945,14 +960,15 @@ instance to edit a toot."
(toot-visibility (alist-get 'visibility toot))
(toot-language (alist-get 'language toot))
(reply-id (alist-get 'in_reply_to_id toot))
- (media (alist-get 'media_attachments toot)))
+ (media (alist-get 'media_attachments toot))
+ (poll (alist-get 'poll toot)))
(when (y-or-n-p "Edit this toot? ")
(mastodon-toot--compose-buffer nil reply-id nil content :edit)
(goto-char (point-max))
;; adopt reply-to-id, visibility, CW, language, and media:
(mastodon-toot--set-toot-properties reply-id toot-visibility
- source-cw toot-language nil nil
- media)
+ source-cw toot-language nil
+ nil media poll)
(setq mastodon-toot--edit-item-id id)))))))
(defun mastodon-toot--get-toot-source (id)
@@ -1275,9 +1291,10 @@ File is actually attached to the toot upon posting."
(defun mastodon-toot--attachment-descriptions ()
"Return a list of image descriptions for current attachments."
- (mapcar (lambda (a)
- (alist-get :description a))
- mastodon-toot--media-attachments))
+ (mastodon-tl--map-alist :description
+ ;; (mapcar (lambda (a)
+ ;; (alist-get :description a))
+ mastodon-toot--media-attachments))
(defun mastodon-toot--attachment-from-desc (desc)
"Return an attachment based on its description DESC."
@@ -1381,11 +1398,14 @@ MAX is the maximum number set by their instance."
(multiple-p (y-or-n-p "Multiple choice? "))
(options (mastodon-toot--read-poll-options count length))
(hide-totals (y-or-n-p "Hide votes until poll ends? "))
- (expiry (mastodon-toot--read-poll-expiry)))
+ (expiry (mastodon-toot--read-poll-expiry))
+ (expiry-str (cdr expiry))
+ (expiry-human (car expiry)))
(setq mastodon-toot-poll
- `(:options ,options :length ,length :multi ,multiple-p
- :hide ,hide-totals :expiry ,expiry))
- (message "poll created!")))
+ `( :options ,options :length ,length :expiry-readable ,expiry-human
+ :expiry ,expiry-str :multi ,multiple-p :hide ,hide-totals))
+ (message "poll created!")
+ (mastodon-toot--update-status-fields)))
(defun mastodon-toot--read-poll-options (count length)
"Read a list of options for poll with COUNT options.
@@ -1403,15 +1423,15 @@ LENGTH is the maximum character length allowed for a
poll option."
choices)))
(defun mastodon-toot--read-poll-expiry ()
- "Prompt for a poll expiry time."
+ "Prompt for a poll expiry time.
+Return a cons of a human readable string, and a seconds-from-now string."
;; API requires this in seconds
(let* ((options (mastodon-toot--poll-expiry-options-alist))
(response (completing-read "poll ends in [or enter seconds]: "
options nil 'confirm)))
- (or (alist-get response options nil nil #'equal)
+ (or (assoc response options #'equal)
(if (< (string-to-number response) 600)
- "600" ;; min 5 mins
- response))))
+ (car options))))) ;; min 5 mins
(defun mastodon-toot--poll-expiry-options-alist ()
"Return an alist of expiry options options in seconds."
@@ -1425,6 +1445,36 @@ LENGTH is the maximum character length allowed for a
poll option."
("14 days" . ,(number-to-string (* 60 60 24 14)))
("30 days" . ,(number-to-string (* 60 60 24 30)))))
+(defun mastodon-toot--clear-poll ()
+ "Remove poll from toot compose buffer.
+Sets `mastodon-toot-poll' to nil."
+ (interactive)
+ (if (not mastodon-toot-poll)
+ (user-error "No poll?")
+ (setq mastodon-toot-poll nil)
+ (mastodon-toot--update-status-fields)))
+
+(defun mastodon-toot--server-poll-to-local (json)
+ "Convert server poll data JSON to a `mastodon-toot-poll' plist."
+ (let-alist json
+ (let* ((expiry-seconds-from-now
+ (time-to-seconds
+ (time-subtract
+ (encode-time
+ (parse-time-string .expires_at))
+ (current-time))))
+ (expiry-str
+ (format-time-string "%s"
+ expiry-seconds-from-now))
+ (expiry-human (car (mastodon-tl--human-duration
expiry-seconds-from-now)))
+ (options (mastodon-tl--map-alist 'title .options))
+ (multiple (if (eq :json-false .multiple)
+ nil
+ t)))
+ (setq mastodon-toot-poll
+ `( :options ,options :expiry-readable ,expiry-human
+ :expiry ,expiry-str :multi ,multiple)))))
+
;;; SCHEDULE
@@ -1607,6 +1657,9 @@ REPLY-TEXT is the text of the toot being replied to."
(propertize "CW"
'toot-post-cw-flag t)
" "
+ (propertize "POLL"
+ 'toot-post-poll-flag t)
+ " "
(propertize "NSFW"
'toot-post-nsfw-flag t)
"\n"
@@ -1688,53 +1741,72 @@ REPLY-REGION is a string to be injected into the
buffer."
(point-min)))
(count-region (mastodon-tl--find-property-range 'toot-post-counter
(point-min)))
- (visibility-region (mastodon-tl--find-property-range
- 'toot-post-visibility (point-min)))
+ (vis-region (mastodon-tl--find-property-range
+ 'toot-post-visibility (point-min)))
(nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag
(point-min)))
(cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag
(point-min)))
(lang-region (mastodon-tl--find-property-range 'toot-post-language
(point-min)))
- (scheduled-region (mastodon-tl--find-property-range
'toot-post-scheduled
- (point-min)))
+ (sched-region (mastodon-tl--find-property-range 'toot-post-scheduled
+ (point-min)))
+ (poll-region (mastodon-tl--find-property-range 'toot-post-poll-flag
+ (point-min)))
(toot-string (buffer-substring-no-properties (cdr header-region)
(point-max))))
- (add-text-properties (car count-region) (cdr count-region)
- (list 'display
- (format "%s/%s chars"
- (mastodon-toot--count-toot-chars
toot-string)
- (number-to-string
mastodon-toot--max-toot-chars))))
- (add-text-properties (car visibility-region) (cdr visibility-region)
- (list 'display
- (format "%s"
- (if (equal
- mastodon-toot--visibility
- "private")
- "followers-only"
- mastodon-toot--visibility))))
- (add-text-properties (car lang-region) (cdr lang-region)
- (list 'display
- (if mastodon-toot--language
- (format "Lang: %s ⋅"
- mastodon-toot--language)
- "")))
- (add-text-properties (car scheduled-region) (cdr scheduled-region)
- (list 'display
- (if mastodon-toot--scheduled-for
- (format "Scheduled: %s ⋅"
- (mastodon-toot--iso-to-human
- mastodon-toot--scheduled-for))
- "")))
- (add-text-properties (car nsfw-region) (cdr nsfw-region)
- (list 'display (if mastodon-toot--content-nsfw
- (if
mastodon-toot--media-attachments
- "NSFW" "NSFW (for
attachments only)")
- "")
- 'face 'mastodon-cw-face))
- (add-text-properties (car cw-region) (cdr cw-region)
- (list 'invisible (not
mastodon-toot--content-warning)
- 'face 'mastodon-cw-face)))))
+ (mastodon-toot--apply-fields-props
+ count-region
+ (format "%s/%s chars"
+ (mastodon-toot--count-toot-chars toot-string)
+ (number-to-string mastodon-toot--max-toot-chars)))
+ (mastodon-toot--apply-fields-props
+ vis-region
+ (format "%s"
+ (if (equal
+ mastodon-toot--visibility
+ "private")
+ "followers-only"
+ mastodon-toot--visibility)))
+ (mastodon-toot--apply-fields-props
+ lang-region
+ (if mastodon-toot--language
+ (format "Lang: %s ⋅"
+ mastodon-toot--language)
+ ""))
+ (mastodon-toot--apply-fields-props
+ sched-region
+ (if mastodon-toot--scheduled-for
+ (format "Scheduled: %s ⋅"
+ (mastodon-toot--iso-to-human
+ mastodon-toot--scheduled-for))
+ ""))
+ (mastodon-toot--apply-fields-props
+ nsfw-region
+ (if mastodon-toot--content-nsfw
+ (if mastodon-toot--media-attachments
+ "NSFW" "NSFW (attachments only)")
+ "")
+ 'mastodon-cw-face)
+ (mastodon-toot--apply-fields-props
+ poll-region
+ (if mastodon-toot-poll "POLL" "")
+ 'mastodon-cw-face
+ (prin1-to-string mastodon-toot-poll))
+ (mastodon-toot--apply-fields-props
+ cw-region
+ (if mastodon-toot--content-warning
+ "CW"
+ " ") ;; hold the blank space
+ 'mastodon-cw-face))))
+
+(defun mastodon-toot--apply-fields-props (region display &optional face
help-echo)
+ "Apply DISPLAY props FACE and HELP-ECHO to REGION, a cons of beg and end."
+ (add-text-properties (car region) (cdr region)
+ `(display
+ ,display
+ ,@(when face `(face ,face))
+ ,@(when help-echo `(help-echo ,help-echo)))))
(defun mastodon-toot--count-toot-chars (toot-string &optional cw)
"Count the characters in TOOT-STRING.
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index a0b5bbc6c2..d0dddeeb6f 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -6,7 +6,7 @@
;; Author: Johnson Denen <johnson.de...@gmail.com>
;; Marty Hiatt <martianhia...@riseup.net>
;; Maintainer: Marty Hiatt <martianhia...@riseup.net>
-;; Version: 1.0.23
+;; Version: 1.0.24
;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4"))
;; Homepage: https://codeberg.org/martianh/mastodon.el
@@ -338,7 +338,7 @@ If REPLY-JSON is the json of the toot being replied to."
(mastodon-toot--compose-buffer user reply-to-id reply-json))
;;;###autoload
-(defun mastodon-notifications-get (&optional type buffer-name force)
+(defun mastodon-notifications-get (&optional type buffer-name force max-id)
"Display NOTIFICATIONS in buffer.
Optionally only print notifications of type TYPE, a string.
BUFFER-NAME is added to \"*mastodon-\" to create the buffer name.
@@ -356,7 +356,9 @@ from the server and load anew."
(mastodon-tl--init-sync (or buffer-name "notifications")
"notifications"
'mastodon-notifications--timeline
- type)
+ type
+ (when max-id
+ `(("max_id" . ,(mastodon-tl--buffer-property
'max-id)))))
(with-current-buffer buffer
(use-local-map mastodon-notifications--map)))))
diff --git a/mastodon-index.org b/mastodon-index.org
index 0108fceaf0..4637403013 100644
--- a/mastodon-index.org
+++ b/mastodon-index.org
@@ -137,6 +137,7 @@
| | mastodon-tl--single-toot | View
toot at point in separate buffer. |
| | mastodon-tl--some-followed-tags-timeline |
Prompt for some tags, and open a timeline for them. |
| RET, T | mastodon-tl--thread | Open
thread buffer for toot at point or with ID. |
+| | mastodon-tl--toggle-sensitive-image |
Toggle dislay of sensitive image at point. |
| | mastodon-tl--toggle-spoiler-in-thread |
Toggler content warning for all posts in current thread. |
| c | mastodon-tl--toggle-spoiler-text-in-toot |
Toggle the visibility of the spoiler text in the current toot. |
| C-S-b | mastodon-tl--unblock-user | Query
for USER-HANDLE from list of blocked users and unblock that user. |
@@ -155,6 +156,7 @@
| C-c C-k | mastodon-toot--cancel | Kill
new-toot buffer/window. Does not POST content. |
| C-c C-v | mastodon-toot--change-visibility |
Change the current visibility to the next valid value. |
| C-c ! | mastodon-toot--clear-all-attachments |
Remove all attachments from a toot draft. |
+| C-c C-o | mastodon-toot--clear-poll |
Remove poll from toot compose buffer. |
| | mastodon-toot--copy-toot-text | Copy
text of toot at point. |
| C | mastodon-toot--copy-toot-url | Copy
URL of toot at point. |
| C-c C-p | mastodon-toot--create-poll |
Prompt for new poll options and return as a list. |
@@ -246,6 +248,7 @@
| mastodon-instance-url | Base URL for
the fediverse instance you want to be active. |
| mastodon-media--avatar-height | Height of the
user avatar images (if shown). |
| mastodon-media--enable-image-caching | Whether
images should be cached. |
+| mastodon-media--hide-sensitive-media | Whether media
marked as sensitive should be hidden. |
| mastodon-media--preview-max-height | Max height of
any media attachment preview to be shown in timelines. |
| mastodon-mode-hook | Hook run when
entering Mastodon mode. |
| mastodon-notifications--profile-note-in-foll-reqs | If non-nil,
show a user's profile note in follow request notifications. |
