diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/.dir-locals.el | 6 | ||||
| -rw-r--r-- | lisp/mastodon-async.el | 1 | ||||
| -rw-r--r-- | lisp/mastodon-auth.el | 5 | ||||
| -rw-r--r-- | lisp/mastodon-client.el | 1 | ||||
| -rw-r--r-- | lisp/mastodon-discover.el | 6 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 11 | ||||
| -rw-r--r-- | lisp/mastodon-inspect.el | 1 | ||||
| -rw-r--r-- | lisp/mastodon-iso.el | 1 | ||||
| -rw-r--r-- | lisp/mastodon-media.el | 80 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 1 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 116 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 3 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 66 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 233 | ||||
| -rw-r--r-- | lisp/mastodon-views.el | 9 | ||||
| -rw-r--r-- | lisp/mastodon.el | 21 |
16 files changed, 373 insertions, 188 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 |