diff options
Diffstat (limited to 'lisp/mastodon-toot.el')
| -rw-r--r-- | lisp/mastodon-toot.el | 199 |
1 files changed, 145 insertions, 54 deletions
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 138602a..9f46cb6 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -76,9 +76,12 @@ (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-profile--get-source-pref "mastodon-profile") (autoload 'mastodon-profile--update-preference "mastodon-profile") -(autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") (autoload 'mastodon-tl--render-text "mastodon-tl") -(autoload 'mastodon-profile-fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-http--build-array-args-alist "mastodon-http") +(autoload 'mastodon-tl--get-endpoint "mastodon-tl") +(autoload 'mastodon-http--put "mastodon-http") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -155,7 +158,7 @@ Valid values are \"direct\", \"private\" (followers-only), This is determined by the account setting on the server. To change the setting on the server, see -`mastodon-toot-set-default-visibility'.") +`mastodon-toot--set-default-visibility'.") (defvar-local mastodon-toot--media-attachments nil "A list of the media attachments of the toot being composed.") @@ -169,6 +172,8 @@ change the setting on the server, see (defvar-local mastodon-toot--reply-to-id nil "Buffer-local variable to hold the id of the toot being replied to.") +(defvar-local mastodon-toot--edit-toot-id nil + "The id of the toot being edited.") (defvar-local mastodon-toot-previous-window-config nil "A list of window configuration prior to composing a toot. @@ -186,7 +191,7 @@ For the moment we just put all composed toots in here, as we want to also capture toots that are 'sent' but that don't successfully send.") -(defvar mastodon-handle-regex +(defvar mastodon-toot-handle-regex (concat ;; preceding space or bol [boundary doesn't work with @] "\\([\n\t ]\\|^\\)" @@ -209,7 +214,7 @@ send.") map) "Keymap for `mastodon-toot'.") -(defun mastodon-toot-set-default-visibility () +(defun mastodon-toot--set-default-visibility () "Set the default visibility for toots on the server." (interactive) (let ((vis (completing-read "Set default visibility to:" @@ -274,7 +279,7 @@ boosting, or bookmarking toots." (mastodon-tl--as-string id) "/" action)))) - (let ((response (mastodon-http--post url nil nil))) + (let ((response (mastodon-http--post url))) (mastodon-http--triage response callback)))) (defun mastodon-toot--toggle-boost-or-favourite (type) @@ -416,7 +421,8 @@ Uses `lingva.el'." (defun mastodon-toot--pin-toot-toggle () "Pin or unpin user's toot at point." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) + (let* ((toot (or (mastodon-tl--property 'base-toot) ;fave/boost notifs + (mastodon-tl--property 'toot-json))) (pinnable-p (mastodon-toot--own-toot-p toot)) (pinned-p (equal (alist-get 'pinned toot) t)) (action (if pinned-p "unpin" "pin")) @@ -441,7 +447,8 @@ Uses `lingva.el'." "Delete and redraft user's toot at point synchronously. NO-REDRAFT means delete toot only." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) + (let* ((toot (or (mastodon-tl--property 'base-toot) ;fave/boost notifs + (mastodon-tl--property 'toot-json))) (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) (url (mastodon-http--api (format "statuses/%s" id))) (toot-cw (alist-get 'spoiler_text toot)) @@ -466,7 +473,7 @@ NO-REDRAFT means delete toot only." toot-visibility toot-cw))))))))) -(defun mastodon-toot-set-cw (&optional cw) +(defun mastodon-toot--set-cw (&optional cw) "Set content warning to CW if it is non-nil." (unless (string-empty-p cw) (setq mastodon-toot--content-warning t) @@ -485,7 +492,7 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." (when reply-id (setq mastodon-toot--reply-to-id reply-id)) (setq mastodon-toot--visibility toot-visibility) - (mastodon-toot-set-cw toot-cw) + (mastodon-toot--set-cw toot-cw) (mastodon-toot--update-status-fields)))) (defun mastodon-toot--kill (&optional cancel) @@ -505,13 +512,13 @@ CANCEL means the toot was not sent, so we save the toot text as a draft." "Kill new-toot buffer/window. Does not POST content to Mastodon. If toot is not empty, prompt to save text as a draft." (interactive) - (if (mastodon-toot-empty-p) + (if (mastodon-toot--empty-p) (mastodon-toot--kill) (when (y-or-n-p "Save draft toot?") - (mastodon-toot-save-draft)) + (mastodon-toot--save-draft)) (mastodon-toot--kill))) -(defun mastodon-toot-save-draft () +(defun mastodon-toot--save-draft () "Save the current compose toot text as a draft. Pushes `mastodon-toot-current-toot-text' to `mastodon-toot-draft-toots-list'." @@ -521,9 +528,9 @@ Pushes `mastodon-toot-current-toot-text' to mastodon-toot-draft-toots-list :test 'equal) (message "Draft saved!"))) -(defun mastodon-toot-empty-p (&optional text-only) - "Return t if no text, attachments, or polls have been added to the compose buffer. -TEXT-ONLY means don't check for attachments." +(defun mastodon-toot--empty-p (&optional text-only) + "Return t if toot has no text, attachments, or polls. +TEXT-ONLY means don't check for attachments or polls." (and (if text-only t (not mastodon-toot--media-attachments) @@ -623,7 +630,8 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--build-poll-params () "Return an alist of parameters for POSTing a poll status." (append - (mastodon-toot--make-poll-options-params + (mastodon-http--build-array-args-alist + "poll[options][]" (plist-get mastodon-toot-poll :options)) `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi)))) @@ -632,13 +640,22 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--send () "POST contents of new-toot buffer to Mastodon instance and kill buffer. If media items have been attached and uploaded with -`mastodon-toot--attach-media', they are attached to the toot." +`mastodon-toot--attach-media', they are attached to the toot. +If `mastodon-toot--edit-toot-id' is non-nil, PUT contents to +instance to edit a toot." (interactive) - (let* ((toot (mastodon-toot--remove-docs)) - (endpoint (mastodon-http--api "statuses")) - (spoiler (when (and (not (mastodon-toot-empty-p)) + (let* ((edit-p (if mastodon-toot--edit-toot-id t nil)) + (toot (mastodon-toot--remove-docs)) + (endpoint + (if edit-p + ;; we are sending an edit: + (mastodon-http--api (format "statuses/%s" + mastodon-toot--edit-toot-id)) + (mastodon-http--api "statuses"))) + (spoiler (when (and (not (mastodon-toot--empty-p)) mastodon-toot--content-warning) - (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft))) + (read-string "Warning: " + mastodon-toot--content-warning-from-reply-or-redraft))) (args-no-media `(("status" . ,toot) ("in_reply_to_id" . ,mastodon-toot--reply-to-id) ("visibility" . ,mastodon-toot--visibility) @@ -646,9 +663,9 @@ If media items have been attached and uploaded with (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mapcar (lambda (id) - (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids))) + (mastodon-http--build-array-args-alist + "media_ids[]" + mastodon-toot--media-attachment-ids))) (args-poll (when mastodon-toot-poll (mastodon-toot--build-poll-params))) ;; media || polls: @@ -668,16 +685,89 @@ If media items have been attached and uploaded with ((and mastodon-toot--max-toot-chars (> (length toot) mastodon-toot--max-toot-chars)) (message "Looks like your toot is longer than that maximum allowed length.")) - ((mastodon-toot-empty-p) + ((mastodon-toot--empty-p) (message "Empty toot. Cowardly refusing to post this.")) (t - (let ((response (mastodon-http--post endpoint args nil))) + (let ((response (if edit-p + ;; we are sending an edit: + (mastodon-http--put endpoint args) + (mastodon-http--post endpoint args)))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) (message "Toot toot!") (mastodon-toot--restore-previous-window-config prev-window-config)))))))) +;; EDITING TOOTS: + +(defun mastodon-toot--edit-toot-at-point () + "Edit the user's toot at point." + (interactive) + (let ((toot (or (mastodon-tl--property 'base-toot); fave/boost notifs + (mastodon-tl--property 'toot-json)))) + (if (not (mastodon-toot--own-toot-p toot)) + (message "You can only edit your own toots.") + (let* ((id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (source (mastodon-toot--get-toot-source id)) + (content (alist-get 'text source)) + (source-cw (alist-get 'spoiler_text source)) + (toot-visibility (alist-get 'visibility toot)) + (reply-id (alist-get 'in_reply_to_id toot))) + (when (y-or-n-p "Edit this toot? ") + (mastodon-toot--compose-buffer) + (goto-char (point-max)) + (insert content) + ;; adopt reply-to-id, visibility and CW: + (when reply-id + (setq mastodon-toot--reply-to-id reply-id)) + (setq mastodon-toot--visibility toot-visibility) + (mastodon-toot--set-cw source-cw) + (mastodon-toot--update-status-fields) + (setq mastodon-toot--edit-toot-id id)))))) + +(defun mastodon-toot--get-toot-source (id) + "Fetch the source JSON of toot with ID." + (let ((url (mastodon-http--api (format "/statuses/%s/source" id)))) + (mastodon-http--get-json url :silent))) + +(defun mastodon-toot--get-toot-edits (id) + "Return the edit history of toot with ID." + (let* ((url (mastodon-http--api (format "statuses/%s/history" id)))) + (mastodon-http--get-json url))) + +(defun mastodon-toot--view-toot-edits () + "View editing history of the toot at point in a popup buffer." + (interactive) + (let ((history (mastodon-tl--property 'edit-history))) + (with-current-buffer (get-buffer-create "*mastodon-toot-edits*") + (let ((inhibit-read-only t)) + (special-mode) + (erase-buffer) + (let ((count 1)) + (mapc (lambda (x) + (insert (propertize (if (= count 1) + (format "%s [original]:\n" count) + (format "%s:\n" count)) + 'face 'font-lock-comment-face) + (mastodon-toot--insert-toot-iter x) + "\n") + (cl-incf count)) + history)) + (switch-to-buffer-other-window (current-buffer)) + (setq-local header-line-format + (propertize + (format "Edits to toot by %s:" + (alist-get 'username + (alist-get 'account (car history)))) + 'face font-lock-comment-face)))))) + +(defun mastodon-toot--insert-toot-iter (it) + "Insert iteration IT of toot." + (let ((content (alist-get 'content it)) + (account (alist-get 'account it))) + ;; TODO: handle polls, media + (mastodon-tl--render-text content))) + (defun mastodon-toot--restore-previous-window-config (config) "Restore the window CONFIG after killing the toot compose buffer. Buffer-local variable `mastodon-toot-previous-window-config' holds the config." @@ -779,12 +869,15 @@ functions called on ARG to generate formatted candidates, annotation, and meta fields respectively." (interactive (list 'interactive)) (let ((handle-before - (save-match-data - (save-excursion - (re-search-backward mastodon-handle-regex nil :no-error) - (if (match-string-no-properties 2) - (buffer-substring-no-properties (match-beginning 2) (match-end 2)) - ""))))) + ;; hack to handle @handles@with.domains, as "@" is a word/symbol boundary + (if (string= str-prefix "@") + (save-match-data + (save-excursion + (re-search-backward mastodon-toot-handle-regex nil :no-error) + (if (match-string-no-properties 2) + ;; match full handle inc. domain (see the regex for subexp 2) + (buffer-substring-no-properties (match-beginning 2) (match-end 2)) + "")))))) (cl-case command (interactive (company-begin-backend (quote backend-name))) (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode @@ -792,7 +885,10 @@ meta fields respectively." (forward-whitespace -1) (forward-whitespace 1) (looking-at str-prefix))) - (concat str-prefix (substring-no-properties handle-before 1)))) + (if (and (string= str-prefix "@") + (> (length handle-before) 1)) ; more than just @ + (concat str-prefix (substring-no-properties handle-before 1)) ; handle + (concat str-prefix (company-grab-symbol))))) ; tag (candidates (funcall candidates-fun arg)) (annotation (funcall annot-fun arg)) (meta (funcall meta-fun arg))))) @@ -975,12 +1071,6 @@ which is used to attach it to a toot when posting." mastodon-toot--media-attachments)) (list "None"))) -(defun mastodon-toot--make-poll-options-params (options) - "Return an parameter query alist from poll OPTIONS." - (let ((key "poll[options][]")) - (cl-loop for o in options - collect `(,key . ,o)))) - (defun mastodon-toot--fetch-max-poll-options () "Return the maximum number of poll options." (mastodon-toot--fetch-poll-field 'max_options)) @@ -991,7 +1081,7 @@ which is used to attach it to a toot when posting." 50)) ; masto default (defun mastodon-toot--fetch-poll-field (field) - "Return FIELD from the poll settings from the user's instance. " + "Return FIELD from the poll settings from the user's instance." (let* ((instance (mastodon-http--get-json (mastodon-http--api "instance")))) (alist-get field (alist-get 'polls @@ -1023,7 +1113,8 @@ MAX is the maximum number set by their instance." (message "poll created!"))) (defun mastodon-toot--read-poll-options (count length) - "Read a list of options for poll of LENGTH options." + "Read a list of options for poll with COUNT options. +LENGTH is the maximum character length allowed for a poll option." (cl-loop for x from 1 to count collect (read-string (format "Poll option [%s/%s] [max %s chars]: " x count length)))) @@ -1177,7 +1268,7 @@ REPLY-JSON is the full JSON of the toot being replied to." (setq mastodon-toot--reply-to-id reply-to-id) (unless (equal mastodon-toot--visibility reply-visibility) (setq mastodon-toot--visibility reply-visibility)) - (mastodon-toot-set-cw reply-cw)))) + (mastodon-toot--set-cw reply-cw)))) (defun mastodon-toot--update-status-fields (&rest _args) "Update the status fields in the header based on the current state." @@ -1219,7 +1310,7 @@ REPLY-JSON is the full JSON of the toot being replied to." 'face 'mastodon-cw-face))))) (defun mastodon-toot--count-toot-chars (toot-string) - "Count the characters in the current toot. + "Count the characters in TOOT-STRING. URLs always = 23, and domain names of handles are not counted. This is how mastodon does it." (with-temp-buffer @@ -1246,15 +1337,15 @@ Added to `after-change-functions' in new toot buffers." (unless (string-empty-p text) (setq mastodon-toot-current-toot-text text)))) -(defun mastodon-toot-open-draft-toot () +(defun mastodon-toot--open-draft-toot () "Prompt for a draft and compose a toot with it." (interactive) (if mastodon-toot-draft-toots-list (let ((text (completing-read "Select draft toot: " mastodon-toot-draft-toots-list nil t))) - (if (mastodon-toot-compose-buffer-p) - (when (and (not (mastodon-toot-empty-p :text-only)) + (if (mastodon-toot--compose-buffer-p) + (when (and (not (mastodon-toot--empty-p :text-only)) (y-or-n-p "Replace current text with draft?")) (cl-pushnew mastodon-toot-current-toot-text mastodon-toot-draft-toots-list) @@ -1266,11 +1357,11 @@ Added to `after-change-functions' in new toot buffers." ;; (delete-region (point) (point-max)) (insert text)) (mastodon-toot--compose-buffer nil nil nil text))) - (unless (mastodon-toot-compose-buffer-p) + (unless (mastodon-toot--compose-buffer-p) (mastodon-toot--compose-buffer)) (message "No drafts available."))) -(defun mastodon-toot-delete-draft-toot () +(defun mastodon-toot--delete-draft-toot () "Prompt for a draft toot and delete it." (interactive) (if mastodon-toot-draft-toots-list @@ -1283,7 +1374,7 @@ Added to `after-change-functions' in new toot buffers." (message "Draft deleted!")) (message "No drafts to delete."))) -(defun mastodon-toot-delete-all-drafts () +(defun mastodon-toot--delete-all-drafts () "Delete all drafts." (interactive) (setq mastodon-toot-draft-toots-list nil) @@ -1292,7 +1383,7 @@ Added to `after-change-functions' in new toot buffers." (defun mastodon-toot--propertize-tags-and-handles (&rest _args) "Propertize tags and handles in toot compose buffer. Added to `after-change-functions'." - (when (mastodon-toot-compose-buffer-p) + (when (mastodon-toot--compose-buffer-p) (let ((header-region (mastodon-tl--find-property-range 'toot-post-header (point-min)))) @@ -1304,7 +1395,7 @@ Added to `after-change-functions'." 'success (cdr header-region)) (mastodon-toot--propertize-item - mastodon-handle-regex + mastodon-toot-handle-regex 'mastodon-display-name-face (cdr header-region))))) @@ -1317,7 +1408,7 @@ Added to `after-change-functions'." (match-end 2) `(face ,face))))) -(defun mastodon-toot-compose-buffer-p () +(defun mastodon-toot--compose-buffer-p () "Return t if compose buffer is current." (equal (buffer-name (current-buffer)) "*new toot*")) @@ -1375,7 +1466,7 @@ a draft into the buffer." (insert initial-text)))) ;;;###autoload -(add-hook 'mastodon-toot-mode-hook #'mastodon-profile-fetch-server-account-settings-maybe) +(add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe) (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." |