diff options
| -rw-r--r-- | lisp/mastodon-http.el | 8 | ||||
| -rw-r--r-- | lisp/mastodon-media.el | 157 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 38 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 20 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 212 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 348 | ||||
| -rw-r--r-- | lisp/mastodon.el | 8 | ||||
| -rw-r--r-- | mastodon-index.org | 3 |
9 files changed, 557 insertions, 239 deletions
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 60654ff..d6abac4 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 3f6d0df..d14d283 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 c26d0b0..5806893 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 46a56f6..de16b7d 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 d73bf9f..e69366e 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 aa70507..41ecd85 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 654918c..23de8b7 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 a0b5bbc..d0dddee 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -6,7 +6,7 @@ ;; Author: Johnson Denen <johnson.denen@gmail.com> ;; Marty Hiatt <martianhiatus@riseup.net> ;; Maintainer: Marty Hiatt <martianhiatus@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 0108fce..4637403 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. | |