From 2e195ee009071ee024d194a6ac1817966b581420 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 30 Oct 2023 20:15:25 +0100 Subject: update cmd index --- mastodon-index.org | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/mastodon-index.org b/mastodon-index.org index 9227df5..d0918e3 100644 --- a/mastodon-index.org +++ b/mastodon-index.org @@ -81,7 +81,6 @@ | | mastodon-profile--remove-user-from-followers | Remove a user from your followers. | | | mastodon-profile--show-familiar-followers | Show a list of familiar followers. | | P | mastodon-profile--show-user | Query for USER-HANDLE from current status and show that user's profile. | -| | mastodon-profile--toot-json | Get the next toot-json. | | | mastodon-profile--update-display-name | Update display name for your account. | | | mastodon-profile--update-meta-fields | Prompt for new metadata fields information and PATCH the server. | | | mastodon-profile--update-profile-note-cancel | Cancel updating user profile and kill buffer and window. | @@ -93,8 +92,8 @@ | | mastodon-profile--view-preferences | View user preferences in another window. | | | mastodon-profile-mode | Toggle mastodon profile minor mode. | | | mastodon-profile-update-mode | Minor mode to update Mastodon user profile. | +| s | mastodon-search--query | Prompt for a search QUERY and return accounts, statuses, and hashtags. | | | mastodon-search--query-cycle | Cycle through search types: accounts, hashtags, and statuses. | -| s | mastodon-search--query | Prompt for a search QUERY and return accounts, statuses, and hashtags. | | | mastodon-search--trending-statuses | Display a list of statuses trending on your instance. | | | mastodon-search--trending-tags | Display a list of tags trending on your instance. | | | mastodon-search-mode | Toggle mastodon search minor mode. | @@ -109,15 +108,17 @@ | | mastodon-tl--filter-user-user-posts-by-language | Query for USER-HANDLE and enable notifications when they post. | | | mastodon-tl--follow-tag | Prompt for a tag and follow it. | | W | mastodon-tl--follow-user | Query for USER-HANDLE from current status and follow that user. | +| | mastodon-tl--follow-user-disable-boosts | Prompt for a USER-HANDLE, and disable display of boosts in home timeline. | +| | mastodon-tl--follow-user-enable-boosts | Prompt for a USER-HANDLE, and enable display of boosts in home timeline. | | ' | mastodon-tl--followed-tags-timeline | Open a timeline of all your followed tags. | | F | mastodon-tl--get-federated-timeline | Open federated timeline. | | H | mastodon-tl--get-home-timeline | Open home timeline. | | L | mastodon-tl--get-local-timeline | Open local timeline. | | # | mastodon-tl--get-tag-timeline | Prompt for tag and opens its timeline. | -| | mastodon-tl--goto-next-item | Jump to next item, e.g. filter or follow request. | -| C-, n | mastodon-tl--goto-next-item | Jump to next toot header. | -| | mastodon-tl--goto-prev-item | Jump to previous item, e.g. filter or follow request. | -| C-, p | mastodon-tl--goto-prev-item | Jump to last toot header. | +| n | mastodon-tl--goto-next-item | Jump to next item. | +| C- | mastodon-tl--goto-next-toot | | +| p | mastodon-tl--goto-prev-item | Jump to previous item. | +| C- | mastodon-tl--goto-prev-toot | | | " | mastodon-tl--list-followed-tags | List followed tags. View timeline of tag user choses. | | C- | mastodon-tl--mpv-play-video-at-point | Play the video or gif at point with an mpv process. | | | mastodon-tl--mpv-play-video-from-byline | Run `mastodon-tl--mpv-play-video-at-point' on first moving image in post. | -- cgit v1.2.3 From 9a8d24f9fa2b8644ca50191363f16ac3143cfd5e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 31 Oct 2023 12:16:37 +0100 Subject: call remove-overlays in --thread (fix bug display of play if we reload a thread) --- lisp/mastodon-tl.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8c7fab8..589f4ed 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1804,6 +1804,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) -- cgit v1.2.3 From f994ae1b71a8e0b0d4d9c9248e0d55d92e6b3d3e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 31 Oct 2023 15:57:56 +0100 Subject: add role badge to profiles. FIX #504. --- lisp/mastodon-profile.el | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index d3b840e..e21c3dd 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -553,6 +553,15 @@ 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) "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. @@ -603,6 +612,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) -- cgit v1.2.3 From d9959ace123b7beb19252819e9b8d92286d40384 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 2 Nov 2023 11:00:51 +0100 Subject: update info re patches --- mastodon.info | 19 ++++++++++++------- mastodon.texi | 6 ++++-- 2 files changed, 16 insertions(+), 9 deletions(-) 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 -- cgit v1.2.3 From 1da8ab0675928f84790bd684db28d0b7ee14dab8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 6 Nov 2023 11:52:30 +0100 Subject: add cmd to url-lookup with no fedi-like check --- lisp/mastodon.el | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index bb06d1b..6e05bd8 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -341,7 +341,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 +352,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 +375,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 -- cgit v1.2.3 From aa0a2c08f062331b914999e6b04282ccdc8c5a11 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 6 Nov 2023 12:40:04 +0100 Subject: add msg about loss of attachments on editing toot --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b2f860f..0891c51 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -889,7 +889,7 @@ 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))) - (when (y-or-n-p "Edit this toot? ") + (when (y-or-n-p "Edit this toot? (NB: attachments will be lost!) ") (mastodon-toot--compose-buffer nil reply-id nil content :edit) (goto-char (point-max)) ;; adopt reply-to-id, visibility, CW, and language: -- cgit v1.2.3 From 406d87cc7ad075a2c1cc2044e151eba7d8110191 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 6 Nov 2023 20:01:21 +0100 Subject: display-media-p var > defcustom --- lisp/mastodon-tl.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 589f4ed..db185d6 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -119,6 +119,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 @@ -200,9 +204,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.") -- cgit v1.2.3 From f1af40e2c00e9a7db67e4e1c153a77cd61d8c562 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 6 Nov 2023 21:17:53 +0100 Subject: edit toots adopt attachments. FIX #506 - fetch media from url (http--read-file-as-string) - on edit, set media-attachments/-ids with the data from the toot/url - nb: users still can't edit attachments, can only remove all or maintain them as they are. but that's much better than always nuking them! --- lisp/mastodon-http.el | 10 +++++++--- lisp/mastodon-toot.el | 53 ++++++++++++++++++++++++++++++++++----------------- 2 files changed, 43 insertions(+), 20 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 1edc8b5..8764764 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -98,10 +98,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-toot.el b/lisp/mastodon-toot.el index 0891c51..6f1aff9 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -634,19 +634,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. @@ -888,14 +905,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))) - (when (y-or-n-p "Edit this toot? (NB: attachments will be lost!) ") + (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) @@ -1178,7 +1196,8 @@ 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--upload-attached-media (attachment) "Upload a single ATTACHMENT using `mastodon-http--post-media-attachment'. -- cgit v1.2.3 From 8e576fc29715436adbf8bda0432d909e3f15de2e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 9 Nov 2023 22:34:55 +0100 Subject: implement exclude_replies on profile view, inc. cycle --- lisp/mastodon-profile.el | 63 ++++++++++++++++++++++++++++-------------------- lisp/mastodon-tl.el | 2 ++ 2 files changed, 39 insertions(+), 26 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index e21c3dd..4870dae 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.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." @@ -563,19 +565,28 @@ FIELDS means provide a fields vector fetched by other means." 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) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index db185d6..cb478b5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1578,6 +1578,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 -- cgit v1.2.3 From 8108187270e4dd1638013de5a51641f45e3abc09 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 9 Nov 2023 22:35:20 +0100 Subject: buffer-for: fix () to ensure goto point min works on cycle --- lisp/mastodon-profile.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 4870dae..625da0a 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -682,13 +682,13 @@ 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, 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. -- cgit v1.2.3 From 33d0011c7c84389878b3a79fb5d1c0b1afdfa913 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 9 Nov 2023 22:36:13 +0100 Subject: toot--reply: call toot--compose-buffer not just toot --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6f1aff9..aee83ad 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1100,7 +1100,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)) -- cgit v1.2.3 From 1a4c9545ec84edbb847c81e465a542a024b359a8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 10 Nov 2023 10:41:20 +0100 Subject: when active region on reply, insert quoted str in reply buffer --- lisp/mastodon-toot.el | 44 +++++++++++++++++++++++++++++++++++++++----- 1 file changed, 39 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index aee83ad..ed9190d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1089,7 +1089,10 @@ Customize `mastodon-toot-display-orig-in-reply-buffer' to display text of the toot being replied to in the compose buffer." (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)))) @@ -1120,7 +1123,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 @@ -1538,7 +1542,30 @@ 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) + (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." @@ -1548,6 +1575,10 @@ REPLY-JSON is the full JSON of the toot being replied to." (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)) @@ -1768,7 +1799,9 @@ 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 @@ -1801,7 +1834,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: -- cgit v1.2.3 From a6680b093e2b144457f01e994ad71b91535f325e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 10 Nov 2023 16:35:49 +0100 Subject: remove ;; Version: strings in buffers other than mastodon.el --- lisp/mastodon-async.el | 1 - lisp/mastodon-auth.el | 1 - lisp/mastodon-client.el | 1 - lisp/mastodon-discover.el | 1 - lisp/mastodon-http.el | 1 - lisp/mastodon-inspect.el | 1 - lisp/mastodon-iso.el | 1 - lisp/mastodon-media.el | 1 - lisp/mastodon-notifications.el | 1 - lisp/mastodon-profile.el | 1 - lisp/mastodon-search.el | 1 - lisp/mastodon-tl.el | 1 - lisp/mastodon-toot.el | 1 - lisp/mastodon-views.el | 1 - 14 files changed, 14 deletions(-) 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 ;; Maintainer: Marty Hiatt -;; 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..1a3e539 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -4,7 +4,6 @@ ;; Copyright (C) 2021 Abhiseck Paira ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 1.0.0 ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. 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 ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; 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..5548b29 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -5,7 +5,6 @@ ;; Author: Johnson Denen ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 1.0.0 ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 8764764..a357672 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -5,7 +5,6 @@ ;; Author: Johnson Denen ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 1.0.0 ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. 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 ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; 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 -;; 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..561327c 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -5,7 +5,6 @@ ;; Author: Johnson Denen ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 1.0.0 ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. 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 ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; 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 625da0a..4fb73d6 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -5,7 +5,6 @@ ;; Author: Johnson Denen ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 1.0.0 ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 1f39088..ac32efb 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2017-2019 Marty Hiatt ;; Author: Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 1.0.0 ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index cb478b5..8e3ce4a 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -5,7 +5,6 @@ ;; Author: Johnson Denen ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 1.0.0 ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index aee83ad..2951ac8 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -5,7 +5,6 @@ ;; Author: Johnson Denen ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 1.0.0 ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index b1ff70d..28f7c7c 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2020-2022 Marty Hiatt ;; Author: Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 1.0.0 ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. -- cgit v1.2.3 From ff4d7a5ae47c873e2a9f0920cb53f28fd1a4fa5a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 11 Nov 2023 12:10:16 +0100 Subject: docstrings/comments for quote-reply issues --- lisp/mastodon-toot.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6b2f791..7833e47 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1085,7 +1085,9 @@ If TAGS, we search for tags, else we search for handles." (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* ((quote (when (region-active-p) @@ -1542,8 +1544,9 @@ The default is given by `mastodon-toot--default-reply-visibility'." mastodon-toot--default-reply-visibility reply-visibility)))) (defun mastodon-toot--fill-buffer () - "Mark buffer, call fill-region." - (mark-whole-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) @@ -1567,7 +1570,8 @@ The default is given by `mastodon-toot--default-reply-visibility'." 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))) -- cgit v1.2.3 From 693244adecddbacc9d4a21a34902996d44657c8d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 11 Nov 2023 12:10:29 +0100 Subject: add (no replies) to statuses no replies profile view --- lisp/mastodon-profile.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 4fb73d6..1c41f24 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -609,9 +609,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 -- cgit v1.2.3 From 65821b2f24c40fbd5cb703757913af54b7e47243 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 14 Nov 2023 21:20:45 +0100 Subject: update help-echo for new profile cycle cmds --- lisp/mastodon-profile.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 1c41f24..0d93747 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -689,7 +689,8 @@ HEADERS means also fetch link headers for pagination." (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-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) -- cgit v1.2.3 From 945123851999405c493196a1ce85d5f88f609410 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 5 Dec 2023 18:32:36 +0100 Subject: start on emoji-capf for compose buffer --- lisp/mastodon-toot.el | 57 +++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 48 insertions(+), 9 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7833e47..65268e3 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -239,12 +239,20 @@ send.") (group-n 2 ?# (+ (any "A-Z" "a-z" "0-9"))) (| "'" word-boundary))) ; boundary or possessive +(defvar mastodon-emoji-tag-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 @@ -1013,21 +1021,25 @@ 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." ;; 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))))) + (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--mentions-capf () "Build a mentions completion backend for `completion-at-point-functions'." @@ -1069,6 +1081,26 @@ If TAGS, we search for tags, else we search for handles." (lambda (cand) (concat " " (mastodon-toot--tags-annotation-fun cand))))))) +(defun mastodon-toot--emoji-capf () + "Build an emoji completion backend for `completion-at-point-functions'." + (let* ((bounds (mastodon-toot--get-bounds mastodon-emoji-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 :emoji)))) + (and (consp result) result)))) + :exclusive 'no + :annotation-function + (lambda (cand) + (concat " " (mastodon-toot--emoji-annotation-fun cand))))))) + (defun mastodon-toot--mentions-annotation-fun (candidate) "Given a handle completion CANDIDATE, return its annotation string, a username." (caddr (assoc candidate mastodon-toot-completions))) @@ -1079,6 +1111,11 @@ 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 @@ -1816,6 +1853,8 @@ EDIT means we are editing an existing toot, not composing a new one." #'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)) -- cgit v1.2.3 From 589868c98d23ebce4157c3d654e2b5766b414dab Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 8 Dec 2023 11:13:49 +0100 Subject: add image-description text property --- lisp/mastodon-media.el | 3 ++- lisp/mastodon-tl.el | 6 ++++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 561327c..894a21a 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -321,7 +321,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) " "))) (provide 'mastodon-media) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8e3ce4a..97e8bc5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1053,11 +1053,12 @@ message is a link which unhides/hides the main body." (concat "Media:: " .preview_url) ; string .preview_url .remote_url .type .description display-str ; display - 'shr-link) + 'shr-link .description) "\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) "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 @@ -1074,6 +1075,7 @@ 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 'help-echo (if (or (string= type "image") (string= type nil) (string= type "unknown")) ; handle borked images -- cgit v1.2.3 From 0c048e154b5599fb83a2b2b8cc2579e1eef7eb39 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 8 Dec 2023 14:11:50 +0100 Subject: copy image caption cmd --- lisp/mastodon-tl.el | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 97e8bc5..3ee12a9 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -263,6 +263,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 "") #'mastodon-tl--mpv-play-video-at-point) (define-key map (kbd "") #'mastodon-tl--click-image-or-video) map) @@ -1290,6 +1291,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 -- cgit v1.2.3 From c9c9487968c7c03fbeac3fe67d5699961d030fa8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 8 Dec 2023 14:11:58 +0100 Subject: docstring --- lisp/mastodon-tl.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 3ee12a9..ca09a0f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1064,7 +1064,8 @@ message is a link which unhides/hides the main body." 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." (propertize str 'media-url media-url 'media-state (when (string= str "[img]") 'needs-loading) -- cgit v1.2.3 From ee33bd1d2d4f095fe77b26246a71270ef533e735 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 18 Dec 2023 21:50:59 +0100 Subject: toot--send: check for media with media-attachment-ids for speed media-attachments contains image data, so is slow. --- lisp/mastodon-toot.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7833e47..266fa86 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -842,20 +842,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) -- cgit v1.2.3 From 6a306afeed60e28f2725a9cc8240b723329d7b4c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 18 Dec 2023 22:43:11 +0100 Subject: FIX #515. completion-ignore-case t buffer-local for compose --- lisp/mastodon-toot.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 266fa86..90cf9a9 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1810,6 +1810,7 @@ EDIT means we are editing an existing toot, not composing a new one." ;; `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 -- cgit v1.2.3 From 0c7322e839f76882a4993516c5921c8ee82e25fa Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 19 Dec 2023 21:52:42 +0100 Subject: refactor mastodon-toot--make-capf --- lisp/mastodon-toot.el | 63 +++++++++++++++++++-------------------------------- 1 file changed, 23 insertions(+), 40 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 65268e3..14bc7db 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1024,7 +1024,7 @@ Federated user: `username@host.co`." (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 @@ -1041,9 +1041,13 @@ If TAGS, we search for tags, else we search for handles." (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)) +(defun mastodon-toot--make-capf (regex type &optional annot-fun) + "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 @@ -1054,52 +1058,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'." - (let* ((bounds (mastodon-toot--get-bounds mastodon-emoji-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 :emoji)))) - (and (consp result) result)))) - :exclusive 'no - :annotation-function - (lambda (cand) - (concat " " (mastodon-toot--emoji-annotation-fun cand))))))) + (mastodon-toot--make-capf mastodon-emoji-tag-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." -- cgit v1.2.3 From 638e5e09dfcafde824c74d277089fd66fb3c959a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 19 Dec 2023 21:59:37 +0100 Subject: clean up emoji capf --- lisp/mastodon-toot.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 14bc7db..0d7e932 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -239,7 +239,7 @@ send.") (group-n 2 ?# (+ (any "A-Z" "a-z" "0-9"))) (| "'" word-boundary))) ; boundary or possessive -(defvar mastodon-emoji-tag-regex +(defvar mastodon-toot-emoji-regex (rx (| (any ?\( "\n" "\t" " ") bol) (group-n 2 ?: ; opening : (+ (any "A-Z" "a-z" "0-9" "_")) @@ -1044,7 +1044,7 @@ TYPE is the candidate type, it may be :tags, :handles, or :emoji." (defun mastodon-toot--make-capf (regex type &optional annot-fun) "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'. +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)) @@ -1080,7 +1080,7 @@ arg, a candidate." (defun mastodon-toot--emoji-capf () "Build an emoji completion backend for `completion-at-point-functions'." - (mastodon-toot--make-capf mastodon-emoji-tag-regex + (mastodon-toot--make-capf mastodon-toot-emoji-regex #'mastodon-toot--emoji-annotation-fun :emoji)) @@ -1094,10 +1094,10 @@ arg, a candidate." ;; or make it an alist and use cdr (cadr (assoc candidate mastodon-toot-completions))) -(defun mastodon-toot--emoji-annotation-fun (candidate) - "" +(defun mastodon-toot--emoji-annotation-fun (_candidate) + "." ;; TODO: emoji image as annot -) + ) ;;; REPLY -- cgit v1.2.3 From 792e18037d2de677d969cabd19bdf1086e760218 Mon Sep 17 00:00:00 2001 From: David Edmondson Date: Tue, 19 Dec 2023 18:39:02 +0000 Subject: Use `equal' to access alist entries by `mastodon-instance-url' If a user re-loads their mastodon.el configuration within an emacs session after using mastodon.el, the variable `mastodon-instance-url' may no longer be considered `eq' to the original value, even if they are the same string. To avoid this problem, compare using `equal'. --- lisp/mastodon-auth.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 1a3e539..279377b 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -172,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. -- cgit v1.2.3 From 2f68bc776d69638eb4d83ad06a4bc3313c0e83e2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 22 Dec 2023 15:50:57 +0100 Subject: tl--content: only call tl--media if we have media --- lisp/mastodon-tl.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index ca09a0f..a8a1264 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1308,11 +1308,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." -- cgit v1.2.3 From 138541647985aa408e9e15d018c23095af28fe08 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 23 Dec 2023 15:38:49 +0100 Subject: add RET binding for tl--thread --- lisp/mastodon.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 6e05bd8..acd1462 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -181,6 +181,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (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)) -- cgit v1.2.3 From 3437dbbeeaa340e85ad1f2e9108469761c3e1aa6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 23 Dec 2023 15:39:30 +0100 Subject: add sensitive property to images, so we can blur them one day. --- lisp/mastodon-media.el | 78 ++++++++++++++++++++++++++------------------------ lisp/mastodon-tl.el | 22 ++++++++------ 2 files changed, 55 insertions(+), 45 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 894a21a..9dd22f4 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -182,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. @@ -259,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") @@ -274,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 @@ -306,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 +326,7 @@ CAPTION is the image caption if provided." (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) - nil caption) + nil caption sensitive) " "))) (provide 'mastodon-media) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a8a1264..561087e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1031,15 +1031,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 @@ -1048,24 +1052,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 .description) + '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 caption) + &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. -CAPTION is the image caption, added as a text property." +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) @@ -1078,6 +1083,7 @@ CAPTION is the image caption, added as a text property." '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 -- cgit v1.2.3 From 20b41bfa9512cc643c23b8e3d8062c8bebf0be79 Mon Sep 17 00:00:00 2001 From: Björn Bidar Date: Thu, 5 Oct 2023 21:24:08 +0300 Subject: Avoid error when there's only one window in a frame when closing window MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Use `(quit-window 'kill)` instead of `(kill-buffer-and-window)` to avoid error when there's only one window instead the frame: `kill-buffer-and-window: Attempt to delete minibuffer or sole ordinary window` Signed-off-by: Björn Bidar --- lisp/mastodon-discover.el | 4 +++- lisp/mastodon-profile.el | 7 ++++--- lisp/mastodon-toot.el | 3 ++- lisp/mastodon.el | 8 +++++++- 4 files changed, 16 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 5548b29..715954f 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -35,6 +35,8 @@ (declare-function discover-add-context-menu "discover") +(autoload 'mastodon-kill-window "mastodon") + (defun mastodon-discover () "Plug Mastodon functionality into `discover'." (interactive) @@ -115,7 +117,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-profile.el b/lisp/mastodon-profile.el index 0d93747..22dd586 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -50,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") @@ -294,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." @@ -310,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) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c96ee5b..c26db1e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -64,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") @@ -682,7 +683,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 () diff --git a/lisp/mastodon.el b/lisp/mastodon.el index acd1462..bac4d67 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) -- cgit v1.2.3 From f3cfd273f9d7f23cff8da1f483e975eaefba6e0e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 31 Dec 2023 11:01:16 +0100 Subject: mastodon--kill-window in toot-tests.el --- test/mastodon-toot-tests.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) 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." -- cgit v1.2.3 From 6fc44fe225ad229500509af6a985f58c6805481d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 31 Dec 2023 11:11:32 +0100 Subject: fix signature of make-capf so we call it right! --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c26db1e..f60f314 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1042,7 +1042,7 @@ TYPE is the candidate type, it may be :tags, :handles, or :emoji." (mastodon-search--search-accounts-query (buffer-substring-no-properties start end)))))) -(defun mastodon-toot--make-capf (regex type &optional annot-fun) +(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'. -- cgit v1.2.3 From 3b3f5228ac9637cb40d15b829912887f72a0590e Mon Sep 17 00:00:00 2001 From: David Edmondson Date: Mon, 15 Jan 2024 13:34:33 +0000 Subject: profile: Use v2 search when looking for users --- lisp/mastodon-profile.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 22dd586..fc90cf7 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -777,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)))) -- cgit v1.2.3 From 231b43a372f2ef0393b52222b0ab177259eb446d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 21 Jan 2024 10:40:02 +0100 Subject: mastodon-tl--tag-timeline-tags defcustom --- lisp/mastodon-tl.el | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 561087e..3d8e8dd 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -190,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 @@ -2206,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) -- cgit v1.2.3 From 38f9437ad99db8a94f64e721f80294c54d7b7ecb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 22 Jan 2024 10:21:18 +0100 Subject: preserve media when editing scheduled toot --- lisp/mastodon-views.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 28f7c7c..8e04434 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -572,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 -- cgit v1.2.3 From 9ffe93009cbcf40a4b0aab103c8bcd98bb291ba7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 22 Jan 2024 11:16:41 +0100 Subject: edit attachments description fun --- lisp/mastodon-toot.el | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index f60f314..6febec7 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1225,6 +1225,30 @@ File is actually attached to the toot upon posting." (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'. The item's id is added to `mastodon-toot--media-attachment-ids', -- cgit v1.2.3 From 844a97ca891650891b233e3c06d72a0a2ede7048 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 26 Jan 2024 14:50:44 +0100 Subject: fix typo in fun name --- lisp/mastodon-search.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index ac32efb..d73bf9f 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -234,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)) -- cgit v1.2.3 From fa73817c225783f09e59f71d8724c62352c36776 Mon Sep 17 00:00:00 2001 From: David Edmondson Date: Tue, 16 Jan 2024 13:54:26 +0000 Subject: Add 'z' binding to bury the current buffer --- lisp/mastodon.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index bac4d67..51fe6a5 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -225,6 +225,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'.") -- cgit v1.2.3 From f0137a0ad60df4ac8b78020f155e33f733493027 Mon Sep 17 00:00:00 2001 From: David Edmondson Date: Tue, 16 Jan 2024 14:00:34 +0000 Subject: Add 'o' binding to open the current toot in a browser --- lisp/mastodon-discover.el | 1 + lisp/mastodon-toot.el | 5 +++++ lisp/mastodon.el | 1 + 3 files changed, 7 insertions(+) diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 715954f..c34d85f 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -65,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) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6febec7..bffa20e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -517,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) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 51fe6a5..9dac1d1 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -184,6 +184,7 @@ 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) -- cgit v1.2.3 From b8dd95b4c948a7510f26f0c98747b4187da28048 Mon Sep 17 00:00:00 2001 From: David Edmondson Date: Tue, 16 Jan 2024 15:23:08 +0000 Subject: dir-locals: Set indent-tab-mode to nil --- lisp/.dir-locals.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 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")))) -- cgit v1.2.3