aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormarty hiatt <martianhiatus@riseup.net>2024-02-01 15:58:07 +0100
committermarty hiatt <martianhiatus@riseup.net>2024-02-01 15:58:07 +0100
commit136e4d387a99ea5a1eb5cd1eee85d927b04203d1 (patch)
treebc1634665af09e819fbf5a10f749eb345227b9b2
parenta8c80d25b7790746a439ae6c2deea3dc6bcac710 (diff)
parentfda3e5963d803754fc2e4d0bdbc005ab5e47a93d (diff)
Merge branch 'develop'
-rw-r--r--lisp/.dir-locals.el6
-rw-r--r--lisp/mastodon-async.el1
-rw-r--r--lisp/mastodon-auth.el5
-rw-r--r--lisp/mastodon-client.el1
-rw-r--r--lisp/mastodon-discover.el6
-rw-r--r--lisp/mastodon-http.el11
-rw-r--r--lisp/mastodon-inspect.el1
-rw-r--r--lisp/mastodon-iso.el1
-rw-r--r--lisp/mastodon-media.el80
-rw-r--r--lisp/mastodon-notifications.el1
-rw-r--r--lisp/mastodon-profile.el116
-rw-r--r--lisp/mastodon-search.el3
-rw-r--r--lisp/mastodon-tl.el66
-rw-r--r--lisp/mastodon-toot.el233
-rw-r--r--lisp/mastodon-views.el9
-rw-r--r--lisp/mastodon.el21
-rw-r--r--mastodon.info19
-rw-r--r--mastodon.texi6
-rw-r--r--test/mastodon-toot-tests.el6
19 files changed, 392 insertions, 200 deletions
diff --git a/lisp/.dir-locals.el b/lisp/.dir-locals.el
index 44e84e5..bcb8ba5 100644
--- a/lisp/.dir-locals.el
+++ b/lisp/.dir-locals.el
@@ -1,5 +1,7 @@
;;; Directory Local Variables
;;; For more information see (info "(emacs) Directory Variables")
-;; setting this makes package-lint look in the main file for deps:
-((emacs-lisp-mode . ((package-lint-main-file . "mastodon.el"))))
+;; Preferred indentation style:
+((nil . ((indent-tabs-mode . nil)))
+ ;; setting this makes package-lint look in the main file for deps:
+ (emacs-lisp-mode . ((package-lint-main-file . "mastodon.el"))))
diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el
index 9de69db..0c70560 100644
--- a/lisp/mastodon-async.el
+++ b/lisp/mastodon-async.el
@@ -3,7 +3,6 @@
;; Copyright (C) 2017 Alex J. Griffith
;; Author: Alex J. Griffith <griffitaj@gmail.com>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Package-Requires: ((emacs "27.1"))
;; Homepage: https://codeberg.org/martianh/mastodon.el
diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el
index 5867b97..279377b 100644
--- a/lisp/mastodon-auth.el
+++ b/lisp/mastodon-auth.el
@@ -4,7 +4,6 @@
;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org>
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -173,13 +172,13 @@ When ASK is absent return nil."
Generate/save token if none known yet."
(cond (mastodon-auth--token-alist
;; user variables are known and initialised.
- (alist-get mastodon-instance-url mastodon-auth--token-alist))
+ (alist-get mastodon-instance-url mastodon-auth--token-alist nil nil #'equal))
((plist-get (mastodon-client--active-user) :access_token)
;; user variables need to be read from plstore.
(push (cons mastodon-instance-url
(plist-get (mastodon-client--active-user) :access_token))
mastodon-auth--token-alist)
- (alist-get mastodon-instance-url mastodon-auth--token-alist))
+ (alist-get mastodon-instance-url mastodon-auth--token-alist nil nil #'equal))
((null mastodon-active-user)
;; user not aware of 2FA-related changes and has not set
;; `mastodon-active-user'. Make user aware and error out.
diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el
index 9b4fee9..493f9df 100644
--- a/lisp/mastodon-client.el
+++ b/lisp/mastodon-client.el
@@ -4,7 +4,6 @@
;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org>
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el
index da25196..c34d85f 100644
--- a/lisp/mastodon-discover.el
+++ b/lisp/mastodon-discover.el
@@ -5,7 +5,6 @@
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -36,6 +35,8 @@
(declare-function discover-add-context-menu "discover")
+(autoload 'mastodon-kill-window "mastodon")
+
(defun mastodon-discover ()
"Plug Mastodon functionality into `discover'."
(interactive)
@@ -64,6 +65,7 @@
("t" "New toot" mastodon-toot)
("r" "Reply" mastodon-toot--reply)
("C" "Copy toot URL" mastodon-toot--copy-toot-url)
+ ("o" "Open toot URL" mastodon-toot--open-toot-url)
("d" "Delete (your) toot" mastodon-toot--delete-toot)
("D" "Delete and redraft (your) toot" mastodon-toot--delete-toot)
("e" "Edit (your) toot" mastodon-toot--edit-toot-at-point)
@@ -116,7 +118,7 @@
("C-c C-c" "Cycle profile views" mastodon-profile--account-view-cycle))
("Quit"
("q" "Quit mastodon and bury buffer." kill-this-buffer)
- ("Q" "Quit mastodon buffer and kill window." kill-buffer-and-window)
+ ("Q" "Quit mastodon buffer and kill window." mastodon--kill-window)
("M-C-q" "Quit mastodon and kill all buffers." mastodon-kill-all-buffers)))))))
(provide 'mastodon-discover)
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index 1edc8b5..a357672 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -5,7 +5,6 @@
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -98,10 +97,14 @@ RESPONSE if unsuccessful."
(mastodon-http--process-json))))
(message "Error %s: %s" status (alist-get 'error json-response)))))))
-(defun mastodon-http--read-file-as-string (filename)
- "Read a file FILENAME as a string. Used to generate image preview."
+(defun mastodon-http--read-file-as-string (filename &optional url)
+ "Read a file FILENAME as a string.
+Used to generate image preview.
+URL means FILENAME is a URL."
(with-temp-buffer
- (insert-file-contents filename)
+ (if url
+ (url-insert-file-contents filename)
+ (insert-file-contents filename))
(string-to-unibyte (buffer-string))))
(defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p)
diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el
index 0a278ab..43c8ba4 100644
--- a/lisp/mastodon-inspect.el
+++ b/lisp/mastodon-inspect.el
@@ -5,7 +5,6 @@
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
diff --git a/lisp/mastodon-iso.el b/lisp/mastodon-iso.el
index 909d3dd..8ea5635 100644
--- a/lisp/mastodon-iso.el
+++ b/lisp/mastodon-iso.el
@@ -2,7 +2,6 @@
;; Copyright (C) 2022 Marty Hiatt
;; Author: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 04cf0c2..9dd22f4 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -5,7 +5,6 @@
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -183,39 +182,39 @@ with the image."
MEDIA-TYPE is a symbol and either `avatar' or `media-link'.
START is the position where we start loading the image.
REGION-LENGTH is the range from start to propertize."
- (let ((image-options (when (or (image-type-available-p 'imagemagick)
- (image-transforms-p)) ; inbuilt scaling in 27.1
- (cond
- ((eq media-type 'avatar)
- `(:height ,mastodon-media--avatar-height))
- ((eq media-type 'media-link)
- `(:max-height ,mastodon-media--preview-max-height))))))
- (let ((buffer (current-buffer))
- (marker (copy-marker start))
- (url-show-status nil)) ; stop url.el from spamming us about connecting
- (condition-case nil
- ;; catch any errors in url-retrieve so as to not abort
- ;; whatever called us
- (if (and mastodon-media--enable-image-caching
- (url-is-cached url))
- ;; if image url is cached, decompress and use it
- (with-current-buffer (url-fetch-from-cache url)
- (set-buffer-multibyte nil)
- (goto-char (point-min))
- (zlib-decompress-region
- (goto-char (search-forward "\n\n")) (point-max))
- (mastodon-media--process-image-response
- nil marker image-options region-length url))
- ;; else fetch as usual and process-image-response will cache it
- (url-retrieve url #'mastodon-media--process-image-response
- (list marker image-options region-length url)))
- (error (with-current-buffer buffer
- ;; TODO: Consider adding retries
- (put-text-property marker
- (+ marker region-length)
- 'media-state
- 'loading-failed)
- :loading-failed))))))
+ (let ((image-options
+ (when (or (image-type-available-p 'imagemagick)
+ (image-transforms-p)) ; inbuilt scaling in 27.1
+ (cond ((eq media-type 'avatar)
+ `(:height ,mastodon-media--avatar-height))
+ ((eq media-type 'media-link)
+ `(:max-height ,mastodon-media--preview-max-height)))))
+ (buffer (current-buffer))
+ (marker (copy-marker start))
+ (url-show-status nil)) ; stop url.el from spamming us about connecting
+ (condition-case nil
+ ;; catch any errors in url-retrieve so as to not abort
+ ;; whatever called us
+ (if (and mastodon-media--enable-image-caching
+ (url-is-cached url))
+ ;; if image url is cached, decompress and use it
+ (with-current-buffer (url-fetch-from-cache url)
+ (set-buffer-multibyte nil)
+ (goto-char (point-min))
+ (zlib-decompress-region
+ (goto-char (search-forward "\n\n")) (point-max))
+ (mastodon-media--process-image-response
+ nil marker image-options region-length url))
+ ;; else fetch as usual and process-image-response will cache it
+ (url-retrieve url #'mastodon-media--process-image-response
+ (list marker image-options region-length url)))
+ (error (with-current-buffer buffer
+ ;; TODO: Consider adding retries
+ (put-text-property marker
+ (+ marker region-length)
+ 'media-state
+ 'loading-failed)
+ :loading-failed)))))
(defun mastodon-media--select-next-media-line (end-pos)
"Find coordinates of the next media to load before END-POS.
@@ -260,11 +259,13 @@ Replace them with the referenced image."
(media-type (cadr (cdr line-details)))
(type (get-text-property start 'mastodon-media-type))
(image-url (get-text-property start 'media-url)))
+ ;; (sensitive (get-text-property start 'sensitive)))
(if (not (mastodon-media--valid-link-p image-url))
;; mark it at least as not needing loading any more
(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")
@@ -275,7 +276,8 @@ Replace them with the referenced image."
;; "Holds a list of overlays in the buffer.")
(defun mastodon-media--moving-image-overlay (start end)
- "Add play symbol overlay to moving image media items."
+ "Add play symbol overlay to moving image media items.
+START and END are the beginning and end of the media item to overlay."
(let ((ov (make-overlay start end)))
(overlay-put
ov
@@ -307,11 +309,12 @@ Replace them with the referenced image."
" ")))
(defun mastodon-media--get-media-link-rendering
- (media-url &optional full-remote-url type caption)
+ (media-url &optional full-remote-url type caption sensitive)
"Return the string to be written that renders the image at MEDIA-URL.
FULL-REMOTE-URL is used for `shr-browse-image'.
TYPE is the attachment's type field on the server.
-CAPTION is the image caption if provided."
+CAPTION is the image caption if provided.
+SENSITIVE is a flag from the item's JSON data."
(let* ((help-echo-base
"RET/i: load full image (prefix: copy URL), +/-: zoom,\
r: rotate, o: save preview")
@@ -322,7 +325,8 @@ CAPTION is the image caption if provided."
(concat
(mastodon-tl--propertize-img-str-or-url
"[img]" media-url full-remote-url type help-echo
- (create-image mastodon-media--generic-broken-image-data nil t))
+ (create-image mastodon-media--generic-broken-image-data nil t)
+ nil caption sensitive)
" ")))
(provide 'mastodon-media)
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index a1aea31..2c61cd4 100644
--- a/lisp/mastodon-notifications.el
+++ b/lisp/mastodon-notifications.el
@@ -5,7 +5,6 @@
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index d3b840e..fc90cf7 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -5,7 +5,6 @@
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -51,6 +50,7 @@
(autoload 'mastodon-http--patch-json "mastodon-http")
(autoload 'mastodon-http--post "mastodon-http.el")
(autoload 'mastodon-http--triage "mastodon-http.el")
+(autoload 'mastodon-kill-window "mastodon")
(autoload 'mastodon-media--get-media-link-rendering "mastodon-media.el")
(autoload 'mastodon-media--inline-images "mastodon-media.el")
(autoload 'mastodon-mode "mastodon.el")
@@ -140,11 +140,12 @@ contains")
"Get the next item-json."
(mastodon-tl--property 'item-json))
-(defun mastodon-profile--make-author-buffer (account &optional no-reblogs)
+(defun mastodon-profile--make-author-buffer
+ (account &optional no-reblogs no-replies)
"Take an ACCOUNT json and insert a user account into a new buffer.
NO-REBLOGS means do not display boosts in statuses."
(mastodon-profile--make-profile-buffer-for
- account "statuses" #'mastodon-tl--timeline no-reblogs))
+ account "statuses" #'mastodon-tl--timeline no-reblogs nil no-replies))
;; TODO: we shd just load all views' data then switch coz this is slow af:
(defun mastodon-profile--account-view-cycle ()
@@ -153,17 +154,28 @@ NO-REBLOGS means do not display boosts in statuses."
(cond ((mastodon-tl--buffer-type-eq 'profile-statuses)
(mastodon-profile--open-statuses-no-reblogs))
((mastodon-tl--buffer-type-eq 'profile-statuses-no-boosts)
+ (mastodon-profile--open-statuses-no-replies))
+ ((mastodon-tl--buffer-type-eq 'profile-statuses-no-replies)
(mastodon-profile--open-followers))
((mastodon-tl--buffer-type-eq 'profile-followers)
(mastodon-profile--open-following))
((mastodon-tl--buffer-type-eq 'profile-following)
(mastodon-profile--make-author-buffer mastodon-profile--account))))
+(defun mastodon-profile--open-statuses-no-replies ()
+ "Open a profile buffer showing statuses including replies."
+ (interactive)
+ (if mastodon-profile--account
+ (mastodon-profile--make-author-buffer
+ mastodon-profile--account nil :no-replies)
+ (user-error "Not in a mastodon profile")))
+
(defun mastodon-profile--open-statuses-no-reblogs ()
"Open a profile buffer showing statuses without reblogs."
(interactive)
(if mastodon-profile--account
- (mastodon-profile--make-author-buffer mastodon-profile--account :no-reblogs)
+ (mastodon-profile--make-author-buffer
+ mastodon-profile--account :no-reblogs)
(user-error "Not in a mastodon profile")))
(defun mastodon-profile--open-following ()
@@ -171,11 +183,8 @@ NO-REBLOGS means do not display boosts in statuses."
(interactive)
(if mastodon-profile--account
(mastodon-profile--make-profile-buffer-for
- mastodon-profile--account
- "following"
- #'mastodon-profile--format-user
- nil
- :headers)
+ mastodon-profile--account "following"
+ #'mastodon-profile--format-user nil :headers)
(user-error "Not in a mastodon profile")))
(defun mastodon-profile--open-followers ()
@@ -183,30 +192,23 @@ NO-REBLOGS means do not display boosts in statuses."
(interactive)
(if mastodon-profile--account
(mastodon-profile--make-profile-buffer-for
- mastodon-profile--account
- "followers"
- #'mastodon-profile--format-user
- nil
- :headers)
+ mastodon-profile--account "followers"
+ #'mastodon-profile--format-user nil :headers)
(user-error "Not in a mastodon profile")))
(defun mastodon-profile--view-favourites ()
"Open a new buffer displaying the user's favourites."
(interactive)
(message "Loading your favourited toots...")
- (mastodon-tl--init "favourites"
- "favourites"
- 'mastodon-tl--timeline
- :headers))
+ (mastodon-tl--init "favourites" "favourites"
+ 'mastodon-tl--timeline :headers))
(defun mastodon-profile--view-bookmarks ()
"Open a new buffer displaying the user's bookmarks."
(interactive)
(message "Loading your bookmarked toots...")
- (mastodon-tl--init "bookmarks"
- "bookmarks"
- 'mastodon-tl--timeline
- :headers))
+ (mastodon-tl--init "bookmarks" "bookmarks"
+ 'mastodon-tl--timeline :headers))
(defun mastodon-profile--add-account-to-list ()
"Add account of current profile buffer to a list."
@@ -293,7 +295,7 @@ NO-REBLOGS means do not display boosts in statuses."
"Cancel updating user profile and kill buffer and window."
(interactive)
(when (y-or-n-p "Cancel updating your profile note?")
- (kill-buffer-and-window)))
+ (mastodon-kill-window)))
(defun mastodon-profile--note-remove-header ()
"Get the body of a toot from the current compose buffer."
@@ -309,9 +311,9 @@ Ask for confirmation if length > 500 characters."
(url (mastodon-http--api "accounts/update_credentials")))
(if (> (mastodon-toot--count-toot-chars note) 500)
(when (y-or-n-p "Note is over mastodon's max for profile notes (500). Proceed?")
- (kill-buffer-and-window)
+ (quit-window 'kill)
(mastodon-profile--user-profile-send-updated-do url note))
- (kill-buffer-and-window)
+ (quit-window 'kill)
(mastodon-profile--user-profile-send-updated-do url note))))
(defun mastodon-profile--user-profile-send-updated-do (url note)
@@ -553,20 +555,38 @@ FIELDS means provide a fields vector fetched by other means."
(when (not (equal :json-false x))
(setq result x)))))
+(defun mastodon-profile--render-roles (roles)
+ "Return a propertized string of badges for ROLES."
+ (mapconcat
+ (lambda (role)
+ (propertize
+ (alist-get 'name role)
+ 'face `(:box t :foreground ,(alist-get 'color role))))
+ roles))
+
(defun mastodon-profile--make-profile-buffer-for
- (account endpoint-type update-function &optional no-reblogs headers)
+ (account endpoint-type update-function
+ &optional no-reblogs headers no-replies)
"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."
(let-alist account
(let* ((args `(("limit" . ,mastodon-tl--timeline-posts-count)))
- (args (if no-reblogs (push '("exclude_reblogs" . "t") args) args))
+ (args (cond (no-reblogs
+ (push '("exclude_reblogs" . "t") args))
+ (no-replies
+ (push '("exclude_replies" . "t") args))
+ (t
+ args)))
(endpoint (format "accounts/%s/%s" .id endpoint-type))
(url (mastodon-http--api endpoint))
(buffer (concat "*mastodon-" .acct "-"
- (if no-reblogs
- (concat endpoint-type "-no-boosts")
- endpoint-type)
+ (cond (no-reblogs
+ (concat endpoint-type "-no-boosts"))
+ (no-replies
+ (concat endpoint-type "-no-replies"))
+ (t
+ endpoint-type))
"*"))
(response (if headers
(mastodon-http--get-response url args)
@@ -590,9 +610,12 @@ HEADERS means also fetch link headers for pagination."
(is-followers (string= endpoint-type "followers"))
(is-following (string= endpoint-type "following"))
(endpoint-name (cond
- (is-statuses (if no-reblogs
- " TOOTS (no boosts)"
- " TOOTS "))
+ (is-statuses (cond (no-reblogs
+ " TOOTS (no boosts)")
+ (no-replies
+ " TOOTS (no replies)")
+ (t
+ " TOOTS ")))
(is-followers " FOLLOWERS ")
(is-following " FOLLOWING "))))
(insert
@@ -603,6 +626,10 @@ HEADERS means also fetch link headers for pagination."
(mastodon-profile--image-from-account account 'header_static)
"\n"
(propertize .display_name 'face 'mastodon-display-name-face)
+ ;; roles
+ (when .roles
+ (concat " "
+ (mastodon-profile--render-roles .roles)))
"\n"
(propertize (concat "@" .acct) 'face 'default)
(if (equal .locked t)
@@ -658,13 +685,14 @@ HEADERS means also fetch link headers for pagination."
(when (and pinned (equal endpoint-type "statuses"))
(mastodon-profile--insert-statuses-pinned pinned)
(setq mastodon-tl--update-point (point))) ; updates after pinned toots
- (funcall update-function json)))
- (goto-char (point-min))
- (message
- (substitute-command-keys
- ;; "\\[mastodon-profile--account-view-cycle]" ; not always bound?
- "\\`C-c C-c' to cycle profile views: toots, followers, following.
-\\`C-c C-s' to search user's toots.")))))
+ (funcall update-function json))
+ (goto-char (point-min))
+ (message
+ (substitute-command-keys
+ ;; "\\[mastodon-profile--account-view-cycle]" ; not always bound?
+ "\\`C-c C-c' to cycle profile views: toots, no replies, no boosts,\
+ followers, following.
+\\`C-c C-s' to search user's toots."))))))
(defun mastodon-profile--format-joined-date-string (joined)
"Format a human-readable Joined string from timestamp JOINED.
@@ -749,13 +777,13 @@ If the handle does not match a search return then retun NIL."
(let* ((handle (if (string= "@" (substring handle 0 1))
(substring handle 1 (length handle))
handle))
- (args `(("q" . ,handle)))
+ (args `(("q" . ,handle)
+ ("type" . "accounts")))
+ (result (mastodon-http--get-json (mastodon-http--api-search) args))
(matching-account (seq-remove
(lambda (x)
(not (string= (alist-get 'acct x) handle)))
- (mastodon-http--get-json
- (mastodon-http--api "accounts/search")
- args))))
+ (alist-get 'accounts result))))
(when (equal 1 (length matching-account))
(elt matching-account 0))))
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index 1f39088..d73bf9f 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -3,7 +3,6 @@
;; Copyright (C) 2017-2019 Marty Hiatt
;; Author: Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -235,7 +234,7 @@ BUFFER, PARAMS, and UPDATE-FUN are for `mastodon-tl--buffer-spec'."
((equal type "statuses")
(mastodon-search--query query "hashtags")))))
-(defun mastodon-serach--query-accounts-followed (query)
+(defun mastodon-search--query-accounts-followed (query)
"Run an accounts search QUERY, limited to your followers."
(interactive "sSearch mastodon for: ")
(mastodon-search--query query "accounts" :following))
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 8c7fab8..3d8e8dd 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -5,7 +5,6 @@
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -119,6 +118,10 @@ By default fixed width fonts are used."
:type '(boolean :tag "Enable using proportional rather than fixed \
width fonts when rendering HTML text"))
+(defcustom mastodon-tl--display-media-p t
+ "A boolean value stating whether to show media in timelines."
+ :type 'boolean)
+
(defcustom mastodon-tl--display-caption-not-url-when-no-media t
"Display an image's caption rather than URL.
Only has an effect when `mastodon-tl--display-media-p' is set to
@@ -187,6 +190,11 @@ re-load mastodon.el, or restart Emacs."
:type '(choice (const :tag "true" t)
(const :tag "false" nil)
(const :tag "follow server setting" server)))
+
+(defcustom mastodon-tl--tag-timeline-tags nil
+ "A list of up to four tags for use with `mastodon-tl--followed-tags-timeline'."
+ :type '(repeat string))
+
;;; VARIABLES
@@ -200,9 +208,6 @@ If nil `(point-min)' is used instead.")
(defvar-local mastodon-tl--after-update-marker nil
"Marker defining the position of point after the update is done.")
-(defvar mastodon-tl--display-media-p t
- "A boolean value stating whether to show media in timelines.")
-
(defvar-local mastodon-tl--timestamp-next-update nil
"The timestamp when the buffer should next be scanned to update the timestamps.")
@@ -263,6 +268,7 @@ types of mastodon links and not just shr.el-generated ones.")
(define-key map (kbd "u") #'mastodon-tl--update)
;; 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 "<C-return>") #'mastodon-tl--mpv-play-video-at-point)
(define-key map (kbd "<mouse-2>") #'mastodon-tl--click-image-or-video)
map)
@@ -1030,15 +1036,19 @@ message is a link which unhides/hides the main body."
(defun mastodon-tl--media (toot)
"Retrieve a media attachment link for TOOT if one exists."
(let* ((media-attachments (mastodon-tl--field 'media_attachments toot))
- (media-string (mapconcat #'mastodon-tl--media-attachment
- media-attachments "")))
+ (sensitive (mastodon-tl--field 'sensitive toot))
+ (media-string (mapconcat
+ (lambda (x)
+ (mastodon-tl--media-attachment x sensitive))
+ media-attachments "")))
(if (not (and mastodon-tl--display-media-p
(string-empty-p media-string)))
(concat "\n" media-string)
"")))
-(defun mastodon-tl--media-attachment (media-attachment)
- "Return a propertized string for MEDIA-ATTACHMENT."
+(defun mastodon-tl--media-attachment (media-attachment sensitive)
+ "Return a propertized string for MEDIA-ATTACHMENT.
+SENSITIVE is a flag from the item's JSON data."
(let-alist media-attachment
(let ((display-str
(if (and mastodon-tl--display-caption-not-url-when-no-media
@@ -1047,22 +1057,25 @@ message is a link which unhides/hides the main body."
(concat "Media:: " .preview_url))))
(if mastodon-tl--display-media-p
(mastodon-media--get-media-link-rendering ; placeholder: "[img]"
- .preview_url (or .remote_url .url) .type .description) ; 2nd arg for shr-browse-url
+ .preview_url (or .remote_url .url) .type .description sensitive) ; 2nd arg for shr-browse-url
;; return URL/caption:
(concat (mastodon-tl--propertize-img-str-or-url
(concat "Media:: " .preview_url) ; string
.preview_url .remote_url .type .description
display-str ; display
- 'shr-link)
+ 'shr-link .description sensitive)
"\n")))))
(defun mastodon-tl--propertize-img-str-or-url
- (str media-url full-remote-url type help-echo &optional display face)
+ (str media-url full-remote-url type help-echo
+ &optional display face caption sensitive)
"Propertize an media placeholder string \"[img]\" or media URL.
STR is the string to propertize, MEDIA-URL is the preview link,
FULL-REMOTE-URL is the link to the full resolution image on the
server, TYPE is the media type.
-HELP-ECHO, DISPLAY, and FACE are the text properties to add."
+HELP-ECHO, DISPLAY, and FACE are the text properties to add.
+CAPTION is the image caption, added as a text property.
+SENSITIVE is a flag from the item's JSON data."
(propertize str
'media-url media-url
'media-state (when (string= str "[img]") 'needs-loading)
@@ -1074,6 +1087,8 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add."
'mastodon-tab-stop 'image ; for do-link-action-at-point
'image-url full-remote-url ; for shr-browse-image
'keymap mastodon-tl--shr-image-map-replacement
+ 'image-description caption
+ 'sensitive sensitive
'help-echo (if (or (string= type "image")
(string= type nil)
(string= type "unknown")) ; handle borked images
@@ -1288,6 +1303,15 @@ in which case play first video or gif from current toot."
(message "no moving image here?"))
(message "no moving image here?"))))
+(defun mastodon-tl--copy-image-caption ()
+ "Copy the caption of the image at point."
+ (interactive)
+ (if-let ((desc (get-text-property (point) 'image-description)))
+ (progn
+ (kill-new desc)
+ (message "Image caption copied."))
+ (message "No image caption.")))
+
;;; INSERT TOOTS
@@ -1295,11 +1319,13 @@ in which case play first video or gif from current toot."
"Retrieve text content from TOOT.
Runs `mastodon-tl--render-text' and fetches poll or media."
(let* ((content (mastodon-tl--field 'content toot))
- (poll-p (mastodon-tl--field 'poll toot)))
+ (poll-p (mastodon-tl--field 'poll toot))
+ (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--media toot))))
+ (when media-p
+ (mastodon-tl--media toot)))))
(defun mastodon-tl--prev-item-id ()
"Return the id of the last toot inserted into the buffer."
@@ -1577,6 +1603,8 @@ call this function after it is set or use something else."
;; posts inc. boosts:
((string-suffix-p "no-boosts*" buffer-name)
'profile-statuses-no-boosts)
+ ((string-suffix-p "no-replies*" buffer-name)
+ 'profile-statuses-no-replies)
((mastodon-tl--endpoint-str-= "statuses" :suffix)
'profile-statuses)
;; profile followers
@@ -1804,6 +1832,7 @@ 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)
@@ -2182,13 +2211,14 @@ PREFIX is sent to `mastodon-tl--get-tag-timeline', which see."
(mastodon-tl--get-tag-timeline prefix tag))))
(defun mastodon-tl--followed-tags-timeline (&optional prefix)
- "Open a timeline of all your followed tags.
+ "Open a timeline of multiple tags.
PREFIX is sent to `mastodon-tl--show-tag-timeline', which see.
-Note that the number of tags supported is undocumented, and from
-manual testing appears to be limited to a total of four tags."
+If `mastodon-tl--tag-timeline-tags' is set, use its tags, else
+fetch followed tags and load the first four of them."
(interactive "p")
(let* ((followed-tags-json (mastodon-tl--followed-tags))
- (tags (mastodon-tl--map-alist 'name followed-tags-json)))
+ (tags (or mastodon-tl--tag-timeline-tags
+ (mastodon-tl--map-alist 'name followed-tags-json))))
(mastodon-tl--show-tag-timeline prefix tags)))
(defun mastodon-tl--some-followed-tags-timeline (&optional prefix)
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index b2f860f..bffa20e 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -5,7 +5,6 @@
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -65,6 +64,7 @@
(autoload 'mastodon-http--put "mastodon-http")
(autoload 'mastodon-http--read-file-as-string "mastodon-http")
(autoload 'mastodon-http--triage "mastodon-http")
+(autoload 'mastodon-kill-window "mastodon")
(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile")
(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile")
(autoload 'mastodon-profile--get-source-pref "mastodon-profile")
@@ -240,12 +240,20 @@ send.")
(group-n 2 ?# (+ (any "A-Z" "a-z" "0-9")))
(| "'" word-boundary))) ; boundary or possessive
+(defvar mastodon-toot-emoji-regex
+ (rx (| (any ?\( "\n" "\t" " ") bol)
+ (group-n 2 ?: ; opening :
+ (+ (any "A-Z" "a-z" "0-9" "_"))
+ (? ?:)) ; closing :
+ word-boundary)) ; boundary
+
(defvar mastodon-toot-url-regex
;; adapted from ffap-url-regexp
(concat
"\\(?2:\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)" ; uri prefix
"[^ \n\t]*\\)" ; any old thing, that is, i.e. we allow invalid/unwise chars
;; "[ .,:;!?]\\b"))
+ ;; "/" ; poss an ending slash? incompat with boundary end:
"\\>")) ; boundary end
@@ -509,6 +517,11 @@ base toot."
(kill-new url)
(message "Toot URL copied to the clipboard.")))
+(defun mastodon-toot--open-toot-url ()
+ "Open URL of toot at point."
+ (interactive)
+ (browse-url (mastodon-toot--toot-url)))
+
(defun mastodon-toot--toot-url ()
"Return the URL of the base toot at point."
(let* ((toot (or (mastodon-tl--property 'base-toot)
@@ -634,19 +647,36 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved."
;; TODO set new lang/scheduled props here
nil))))
+(defun mastodon-toot--set-toot-media-attachments (media)
+ "Set the media attachments variables.
+MEDIA is the media_attachments data for a status from the server."
+ (mapcar (lambda (x)
+ (cl-pushnew (alist-get 'id x)
+ mastodon-toot--media-attachment-ids)
+ (cl-pushnew `((:contents . ,(mastodon-http--read-file-as-string
+ (alist-get 'url x) :url))
+ (:description . ,(alist-get 'description x)))
+ mastodon-toot--media-attachments))
+ media))
+
(defun mastodon-toot--set-toot-properties
- (reply-id visibility cw lang &optional scheduled scheduled-id)
+ (reply-id visibility cw lang &optional scheduled scheduled-id media)
"Set the toot properties for the current redrafted or edited toot.
-REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set."
- (when reply-id
- (setq mastodon-toot--reply-to-id reply-id))
- (setq mastodon-toot--visibility visibility)
- (setq mastodon-toot--scheduled-for scheduled)
- (setq mastodon-toot--scheduled-id scheduled-id)
- (when (not (string-empty-p lang))
- (setq mastodon-toot--language lang))
- (mastodon-toot--set-cw cw)
- (mastodon-toot--update-status-fields))
+REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set.
+MEDIA is the media_attachments data for a status from the server."
+ (with-current-buffer "*edit toot*"
+ (when reply-id
+ (setq mastodon-toot--reply-to-id reply-id))
+ (setq mastodon-toot--visibility visibility)
+ (setq mastodon-toot--scheduled-for scheduled)
+ (setq mastodon-toot--scheduled-id scheduled-id)
+ (when (not (string-empty-p lang))
+ (setq mastodon-toot--language lang))
+ (mastodon-toot--set-cw cw)
+ (when media
+ (mastodon-toot--set-toot-media-attachments media))
+ (mastodon-toot--refresh-attachments-display)
+ (mastodon-toot--update-status-fields)))
(defun mastodon-toot--kill (&optional cancel)
"Kill `mastodon-toot-mode' buffer and window.
@@ -658,7 +688,7 @@ CANCEL means the toot was not sent, so we save the toot text as a draft."
mastodon-toot-draft-toots-list :test 'equal)))
;; prevent some weird bug when cancelling a non-empty toot:
(delete #'mastodon-toot--save-toot-text after-change-functions)
- (kill-buffer-and-window)
+ (quit-window 'kill)
(mastodon-toot--restore-previous-window-config prev-window-config)))
(defun mastodon-toot--cancel ()
@@ -826,20 +856,20 @@ instance to edit a toot."
;; Pleroma instances can't handle null-valued
;; scheduled_at args, so only add if non-nil
(when scheduled `(("scheduled_at" . ,scheduled)))))
- (args-media (when mastodon-toot--media-attachments
+ (args-media (when mastodon-toot--media-attachment-ids
(mastodon-http--build-array-params-alist
"media_ids[]"
mastodon-toot--media-attachment-ids)))
(args-poll (when mastodon-toot-poll
(mastodon-toot--build-poll-params)))
;; media || polls:
- (args (if mastodon-toot--media-attachments
+ (args (if mastodon-toot--media-attachment-ids
(append args-media args-no-media)
(if mastodon-toot-poll
(append args-no-media args-poll)
args-no-media)))
(prev-window-config mastodon-toot-previous-window-config))
- (cond ((and mastodon-toot--media-attachments
+ (cond ((and mastodon-toot--media-attachment-ids
;; make sure we have media args
;; and the same num of ids as attachments
(or (not args-media)
@@ -888,14 +918,15 @@ instance to edit a toot."
(source-cw (alist-get 'spoiler_text source))
(toot-visibility (alist-get 'visibility toot))
(toot-language (alist-get 'language toot))
- (reply-id (alist-get 'in_reply_to_id toot)))
+ (reply-id (alist-get 'in_reply_to_id toot))
+ (media (alist-get 'media_attachments 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, and language:
+ ;; adopt reply-to-id, visibility, CW, language, and media:
(mastodon-toot--set-toot-properties reply-id toot-visibility
- source-cw toot-language)
- (mastodon-toot--update-status-fields)
+ source-cw toot-language nil nil
+ media)
(setq mastodon-toot--edit-item-id id)))))))
(defun mastodon-toot--get-toot-source (id)
@@ -996,25 +1027,33 @@ Federated user: `username@host.co`."
(cons (match-beginning 2)
(match-end 2))))))
-(defun mastodon-toot--fetch-completion-candidates (start end &optional tags)
+(defun mastodon-toot--fetch-completion-candidates (start end &optional type)
"Search for a completion prefix from buffer positions START to END.
Return a list of candidates.
-If TAGS, we search for tags, else we search for handles."
+TYPE is the candidate type, it may be :tags, :handles, or :emoji."
;; we can't save the first two-letter search then only filter the
;; resulting list, as max results returned is 40.
(setq mastodon-toot-completions
- (if tags
- (let ((tags-list (mastodon-search--search-tags-query
- (buffer-substring-no-properties start end))))
- (cl-loop for tag in tags-list
- collect (cons (concat "#" (car tag))
- (cdr tag))))
- (mastodon-search--search-accounts-query
- (buffer-substring-no-properties start end)))))
-
-(defun mastodon-toot--mentions-capf ()
- "Build a mentions completion backend for `completion-at-point-functions'."
- (let* ((bounds (mastodon-toot--get-bounds mastodon-toot-handle-regex))
+ (cond ((eq type :tags)
+ (let ((tags-list (mastodon-search--search-tags-query
+ (buffer-substring-no-properties start end))))
+ (cl-loop for tag in tags-list
+ collect (cons (concat "#" (car tag))
+ (cdr tag)))))
+ ((eq type :emoji)
+ (cl-loop for e in emojify-user-emojis
+ collect (car e)))
+ (t
+ (mastodon-search--search-accounts-query
+ (buffer-substring-no-properties start end))))))
+
+(defun mastodon-toot--make-capf (regex annot-fun type)
+ "Build a completion backend for `completion-at-point-functions'.
+REGEX is the regex to match preceding text.
+TYPE is a keyword symbol for `mastodon-toot--fetch-completion-candidates'.
+ANNOT-FUN is a function returning an annotatation from a single
+arg, a candidate."
+ (let* ((bounds (mastodon-toot--get-bounds regex))
(start (car bounds))
(end (cdr bounds)))
(when bounds
@@ -1025,32 +1064,31 @@ If TAGS, we search for tags, else we search for handles."
;; Interruptible candidate computation, from minad/d mendler, thanks!
(let ((result
(while-no-input
- (mastodon-toot--fetch-completion-candidates start end))))
+ (mastodon-toot--fetch-completion-candidates
+ start end type))))
(and (consp result) result))))
:exclusive 'no
:annotation-function
(lambda (cand)
- (concat " " (mastodon-toot--mentions-annotation-fun cand)))))))
+ (concat " " (funcall annot-fun cand)))))))
+
+(defun mastodon-toot--mentions-capf ()
+ "Build a mentions completion backend for `completion-at-point-functions'."
+ (mastodon-toot--make-capf mastodon-toot-handle-regex
+ #'mastodon-toot--mentions-annotation-fun
+ :handles))
(defun mastodon-toot--tags-capf ()
"Build a tags completion backend for `completion-at-point-functions'."
- (let* ((bounds (mastodon-toot--get-bounds mastodon-toot-tag-regex))
- (start (car bounds))
- (end (cdr bounds)))
- (when bounds
- (list start
- end
- (completion-table-dynamic ; only search when necessary:
- (lambda (_)
- ;; Interruptible candidate computation, from minad/d mendler, thanks!
- (let ((result
- (while-no-input
- (mastodon-toot--fetch-completion-candidates start end :tags))))
- (and (consp result) result))))
- :exclusive 'no
- :annotation-function
- (lambda (cand)
- (concat " " (mastodon-toot--tags-annotation-fun cand)))))))
+ (mastodon-toot--make-capf mastodon-toot-tag-regex
+ #'mastodon-toot--tags-annotation-fun
+ :tags))
+
+(defun mastodon-toot--emoji-capf ()
+ "Build an emoji completion backend for `completion-at-point-functions'."
+ (mastodon-toot--make-capf mastodon-toot-emoji-regex
+ #'mastodon-toot--emoji-annotation-fun
+ :emoji))
(defun mastodon-toot--mentions-annotation-fun (candidate)
"Given a handle completion CANDIDATE, return its annotation string, a username."
@@ -1062,16 +1100,26 @@ If TAGS, we search for tags, else we search for handles."
;; or make it an alist and use cdr
(cadr (assoc candidate mastodon-toot-completions)))
+(defun mastodon-toot--emoji-annotation-fun (_candidate)
+ "."
+ ;; TODO: emoji image as annot
+ )
+
;;; REPLY
(defun mastodon-toot--reply ()
"Reply to toot at `point'.
Customize `mastodon-toot-display-orig-in-reply-buffer' to display
-text of the toot being replied to in the compose buffer."
+text of the toot being replied to in the compose buffer.
+If the region is active, inject it into the reply buffer,
+prefixed by >."
(interactive)
(mastodon-tl--do-if-item-strict
- (let* ((toot (mastodon-tl--property 'item-json))
+ (let* ((quote (when (region-active-p)
+ (buffer-substring (region-beginning)
+ (region-end))))
+ (toot (mastodon-tl--property 'item-json))
;; no-move arg for base toot: don't try next toot
(base-toot (mastodon-tl--property 'base-toot :no-move)) ; for new notifs handling
(id (mastodon-tl--as-string (mastodon-tl--field 'id (or base-toot toot))))
@@ -1082,7 +1130,7 @@ text of the toot being replied to in the compose buffer."
(booster (when boosted
(alist-get 'acct
(alist-get 'account toot)))))
- (mastodon-toot
+ (mastodon-toot--compose-buffer
(when user
(if booster
(if (and (not (equal user booster))
@@ -1102,7 +1150,8 @@ text of the toot being replied to in the compose buffer."
;; user in mentions already:
(mastodon-toot--mentions-to-string (copy-sequence mentions)))))
id
- (or base-toot toot)))))
+ (or base-toot toot)
+ quote))))
;;; COMPOSE TOOT SETTINGS
@@ -1178,7 +1227,32 @@ File is actually attached to the toot upon posting."
(:filename . ,file)))))
(mastodon-toot--refresh-attachments-display)
;; upload only most recent attachment:
- (mastodon-toot--upload-attached-media (car (last mastodon-toot--media-attachments)))))
+ (mastodon-toot--upload-attached-media
+ (car (last mastodon-toot--media-attachments)))))
+
+(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))
+
+(defun mastodon-toot--attachment-from-desc (desc)
+ "Return an attachment based on its description DESC."
+ (car
+ (cl-member-if (lambda (x)
+ (rassoc desc x))
+ mastodon-toot--media-attachments)))
+
+(defun mastodon-toot--edit-media-description ()
+ "Prompt for an attachment, and update its description."
+ (interactive)
+ (let* ((descs (mastodon-toot--attachment-descriptions))
+ (choice (completing-read "Attachment: " descs nil :match))
+ (attachment (mastodon-toot--attachment-from-desc choice))
+ (desc-new (read-string "Description: " choice)))
+ (setf (alist-get :description attachment)
+ desc-new)
+ (mastodon-toot--refresh-attachments-display)))
(defun mastodon-toot--upload-attached-media (attachment)
"Upload a single ATTACHMENT using `mastodon-http--post-media-attachment'.
@@ -1519,16 +1593,45 @@ The default is given by `mastodon-toot--default-reply-visibility'."
(if (member (intern reply-visibility) less-restrictive)
mastodon-toot--default-reply-visibility reply-visibility))))
-(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id reply-json)
+(defun mastodon-toot--fill-buffer ()
+ "Mark buffer, call `fill-region'."
+ (mark-whole-buffer) ; lisp code should not set mark
+ ;; (fill-region (point-min) (point-max)) ; but this doesn't work
+ (fill-region (region-beginning) (region-end)))
+
+(defun mastodon-toot--render-reply-region-str (str)
+ "Refill STR and prefix all lines with >, as reply-quote text."
+ (with-temp-buffer
+ ;; (switch-to-buffer (current-buffer))
+ (insert str)
+ ;; unfill first:
+ (let ((fill-column (point-max)))
+ (mastodon-toot--fill-buffer))
+ ;; then fill:
+ (mastodon-toot--fill-buffer)
+ ;; add our own prefix, pauschal:
+ (save-match-data
+ (while (re-search-forward "^" nil t)
+ (replace-match " > ")))
+ (buffer-substring-no-properties (point-min)
+ (point-max))))
+
+(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id
+ reply-json reply-region)
"If REPLY-TO-USER is provided, inject their handle into the message.
If REPLY-TO-ID is provided, set `mastodon-toot--reply-to-id'.
-REPLY-JSON is the full JSON of the toot being replied to."
+REPLY-JSON is the full JSON of the toot being replied to.
+REPLY-REGION is a string to be injected into the buffer."
(let ((reply-visibility (mastodon-toot--most-restrictive-visibility
(alist-get 'visibility reply-json)))
(reply-cw (alist-get 'spoiler_text reply-json)))
(when reply-to-user
(when (> (length reply-to-user) 0) ; self is "" unforch
(insert (format "%s " reply-to-user)))
+ (when reply-region
+ (insert "\n"
+ (mastodon-toot--render-reply-region-str reply-region)
+ "\n"))
(setq mastodon-toot--reply-to-id reply-to-id)
(unless (equal mastodon-toot--visibility reply-visibility)
(setq mastodon-toot--visibility reply-visibility))
@@ -1749,18 +1852,23 @@ EDIT means we are editing an existing toot, not composing a new one."
;; perhaps we should not always call --setup-as-reply, or make its
;; workings conditional on reply-to-id. currently it only checks for
;; reply-to-user.
- (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json))
+ (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json
+ ;; only initial-text if reply (not edit):
+ (when reply-json initial-text)))
(unless mastodon-toot--max-toot-chars
;; no need to fetch from `mastodon-profile-account-settings' as
;; `mastodon-toot--max-toot-chars' is set when we set it
(mastodon-toot--get-max-toot-chars))
;; set up completion:
+ (setq-local completion-ignore-case t)
(when mastodon-toot--enable-completion
(set (make-local-variable 'completion-at-point-functions)
(add-to-list 'completion-at-point-functions
#'mastodon-toot--mentions-capf))
(add-to-list 'completion-at-point-functions
#'mastodon-toot--tags-capf)
+ (add-to-list 'completion-at-point-functions
+ #'mastodon-toot--emoji-capf)
;; company
(when (and mastodon-toot--use-company-for-completion
(require 'company nil :no-error))
@@ -1782,7 +1890,8 @@ EDIT means we are editing an existing toot, not composing a new one."
(setq mastodon-toot-previous-window-config previous-window-config)
(when mastodon-toot--proportional-fonts-compose
(facemenu-set-face 'variable-pitch))
- (when initial-text
+ (when (and initial-text
+ (not reply-json))
(insert initial-text))))
;; flyspell ignore masto toot regexes:
diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el
index b1ff70d..8e04434 100644
--- a/lisp/mastodon-views.el
+++ b/lisp/mastodon-views.el
@@ -3,7 +3,6 @@
;; Copyright (C) 2020-2022 Marty Hiatt
;; Author: Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.0
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -573,14 +572,14 @@ NO-CONFIRM means there is no ask or message, there is only do."
(let* ((toot (mastodon-tl--property 'scheduled-json :no-move))
(scheduled (alist-get 'scheduled_at toot)))
(let-alist (alist-get 'params toot)
+ ;; TODO: preserve polls
;; (poll (alist-get 'poll params))
- ;; (media (alist-get 'media_attachments toot)))
- (mastodon-toot--compose-buffer)
+ (mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit)
(goto-char (point-max))
- (insert .text)
;; adopt properties from scheduled toot:
(mastodon-toot--set-toot-properties
- .in_reply_to_id .visibility .spoiler_text .language scheduled id))))))
+ .in_reply_to_id .visibility .spoiler_text .language
+ scheduled id (alist-get 'media_attachments toot)))))))
;;; FILTERS
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index bb06d1b..9dac1d1 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -142,6 +142,12 @@ The default value \"%F %T\" prints ISO8601-style YYYY-mm-dd HH:MM:SS.
Use. e.g. \"%c\" for your locale's date and time format."
:type 'string)
+
+(defun mastodon-kill-window ()
+ "Quit window and delete helper."
+ (interactive)
+ (quit-window 'kill))
+
(defvar mastodon-mode-map
(let ((map (make-sparse-keymap)))
;; navigation inside a timeline
@@ -169,7 +175,7 @@ Use. e.g. \"%c\" for your locale's date and time format."
(define-key map (kbd "/") #'mastodon-switch-to-buffer)
;; quitting mastodon
(define-key map (kbd "q") #'kill-current-buffer)
- (define-key map (kbd "Q") #'kill-buffer-and-window)
+ (define-key map (kbd "Q") #'mastodon-kill-window)
(define-key map (kbd "M-C-q") #'mastodon-kill-all-buffers)
;; toot actions
(define-key map (kbd "c") #'mastodon-tl--toggle-spoiler-text-in-toot)
@@ -178,9 +184,11 @@ Use. e.g. \"%c\" for your locale's date and time format."
(define-key map (kbd "k") #'mastodon-toot--toggle-bookmark)
(define-key map (kbd "r") #'mastodon-toot--reply)
(define-key map (kbd "C") #'mastodon-toot--copy-toot-url)
+ (define-key map (kbd "o") #'mastodon-toot--open-toot-url)
(define-key map (kbd "v") #'mastodon-tl--poll-vote)
(define-key map (kbd "E") #'mastodon-toot--view-toot-edits)
(define-key map (kbd "T") #'mastodon-tl--thread)
+ (define-key map (kbd "RET") #'mastodon-tl--thread)
(define-key map (kbd "m") #'mastodon-tl--dm-user)
(when (require 'lingva nil :no-error)
(define-key map (kbd "a") #'mastodon-toot--translate-toot-text))
@@ -218,6 +226,7 @@ Use. e.g. \"%c\" for your locale's date and time format."
(define-key map (kbd "G") #'mastodon-views--view-follow-suggestions)
(define-key map (kbd "X") #'mastodon-views--view-lists)
(define-key map (kbd "SPC") #'mastodon-tl--scroll-up-command)
+ (define-key map (kbd "z") #'bury-buffer)
map)
"Keymap for `mastodon-mode'.")
@@ -341,7 +350,7 @@ from the server and load anew."
;; URL lookup: should be available even if `mastodon.el' not loaded:
;;;###autoload
-(defun mastodon-url-lookup (&optional query-url)
+(defun mastodon-url-lookup (&optional query-url force)
"If a URL resembles a mastodon link, try to load in `mastodon.el'.
Does a WebFinger lookup.
URL can be arg QUERY-URL, or URL at point, or provided by the user.
@@ -352,7 +361,8 @@ not, just browse the URL in the normal fashion."
(thing-at-point-url-at-point)
(mastodon-tl--property 'shr-url :no-move)
(read-string "Lookup URL: "))))
- (if (not (mastodon--fedi-url-p query))
+ (if (and (not force)
+ (not (mastodon--fedi-url-p query)))
;; (shr-browse-url query) ; doesn't work (keep our shr keymap)
(browse-url query)
(message "Performing lookup...")
@@ -374,6 +384,11 @@ not, just browse the URL in the normal fashion."
(t
(browse-url query)))))))
+(defun mastodon-url-lookup-force ()
+ "Call `mastodon-url-lookup' without checking if URL is fedi-like."
+ (interactive)
+ (mastodon-url-lookup nil :force))
+
(defun mastodon--fedi-url-p (query)
"Check if QUERY resembles a fediverse URL."
;; calqued off https://github.com/tuskyapp/Tusky/blob/c8fc2418b8f5458a817bba221d025b822225e130/app/src/main/java/com/keylesspalace/tusky/BottomSheetActivity.kt
diff --git a/mastodon.info b/mastodon.info
index 47c9b9a..16b19d0 100644
--- a/mastodon.info
+++ b/mastodon.info
@@ -601,6 +601,10 @@ File: mastodon.info, Node: Contributing, Next: Supporting mastodonel, Prev: N
PRs, issues, feature requests, and general feedback are very welcome!
+ If you prefer emailing patches to the process described below, feel
+free to send them on. Ideally they’d be patches that can be applied
+with ‘git am’, if you want to actually contribute a commit.
+
* Menu:
* Bug reports::
@@ -622,7 +626,7 @@ File: mastodon.info, Node: Bug reports, Next: Fixes and features, Up: Contrib
(https://codeberg.org/martianh/mastodon.el/issues/300)) to see if
it also happens independently of your own config (it probably
does).
- 4. Enable debug on error (‘toggle-debug-on-error’), make the bug
+ 4. Else enable debug on error (‘toggle-debug-on-error’), make the bug
happen again, and copy the backtrace that appears.
5. Open an issue here and explain what is going on. Provide your
emacs version and what kind of server your account is on.
@@ -637,7 +641,8 @@ File: mastodon.info, Node: Fixes and features, Next: Coding style, Prev: Bug
detailing what you’d like to do.
2. Fork the repository and create a branch off of ‘develop’.
3. Run the tests and ensure that your code doesn’t break any of them.
- 4. Create a pull request referencing the issue created in step 1.
+ 4. Create a pull request (to develop) referencing the issue created in
+ step 1.

File: mastodon.info, Node: Coding style, Prev: Fixes and features, Up: Contributing
@@ -715,11 +720,11 @@ Node: Bookmarks and mastodonel20093
Node: Dependencies20565
Node: Network compatibility21175
Node: Contributing22057
-Node: Bug reports22346
-Node: Fixes and features23252
-Node: Coding style23735
-Node: Supporting mastodonel24359
-Node: Contributors24926
+Node: Bug reports22553
+Node: Fixes and features23464
+Node: Coding style23965
+Node: Supporting mastodonel24589
+Node: Contributors25156

End Tag Table
diff --git a/mastodon.texi b/mastodon.texi
index 872fb81..b33162d 100644
--- a/mastodon.texi
+++ b/mastodon.texi
@@ -717,6 +717,8 @@ free to open an issue.
PRs, issues, feature requests, and general feedback are very welcome!
+If you prefer emailing patches to the process described below, feel free to send them on. Ideally they'd be patches that can be applied with @samp{git am}, if you want to actually contribute a commit.
+
@menu
* Bug reports::
* Fixes and features::
@@ -737,7 +739,7 @@ in emacs with no init file (i.e. @samp{emacs -q} (instructions and code for doin
this are @uref{https://codeberg.org/martianh/mastodon.el/issues/300, here}) to see if it also happens independently of your own config
(it probably does).
@item
-Enable debug on error (@samp{toggle-debug-on-error}), make the bug happen again,
+Else enable debug on error (@samp{toggle-debug-on-error}), make the bug happen again,
and copy the backtrace that appears.
@item
Open an issue here and explain what is going on. Provide your emacs version and what kind of server your account is on.
@@ -754,7 +756,7 @@ Fork the repository and create a branch off of @samp{develop}.
@item
Run the tests and ensure that your code doesn't break any of them.
@item
-Create a pull request referencing the issue created in step 1.
+Create a pull request (to develop) referencing the issue created in step 1.
@end enumerate
@node Coding style
diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el
index 6133453..62f6f86 100644
--- a/test/mastodon-toot-tests.el
+++ b/test/mastodon-toot-tests.el
@@ -117,9 +117,9 @@ mention string."
(list (current-window-configuration)
(point-marker))))
(with-mock
- (mock (kill-buffer-and-window))
- (mastodon-toot--kill)
- (mock-verify))))
+ (mock (mastodon--kill-window))
+ (mastodon-toot--kill)
+ (mock-verify))))
(ert-deftest mastodon-toot--own-toot-p-fail ()
"Should not return t if not own toot."