From 547e4cf02a62d4a625ba13017b65908d77da50a6 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 14 Oct 2021 12:34:17 +0200 Subject: readme --- README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.org b/README.org index 60f04eb..dcccccf 100644 --- a/README.org +++ b/README.org @@ -70,10 +70,10 @@ I might add a few more features if the ones I added turn out to work ok. Possibl - [X] prevent loss of draft toots by the toot-send bug - [X] fix scaling of images - [ ] display post visibility status in timelines +- [ ] caching of images / avatars - better display of polls - display number of boosts/faves in toot byline - mention all thread participants in replies -- handle newlines in toots better, for poetry, etc. - improve (or even partially disable) async. It looks like 2-factor auth was never completed in the original repo. It's not a priority for me, auth ain't my thing. If you want to hack on it, its on the develop branch in the original repo. -- cgit v1.2.3 From 1f2ebe94c647fef509e06e9ef6f79697ef98a356 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 12:57:41 +0200 Subject: first test merge of hdurer's WIP: Posting of images --- lisp/mastodon-auth.el | 30 +++++------ lisp/mastodon-client.el | 8 +-- lisp/mastodon-http.el | 64 +++++++++++++++++++---- lisp/mastodon-media.el | 5 ++ lisp/mastodon-toot.el | 133 +++++++++++++++++++++++++++++++++++------------- 5 files changed, 176 insertions(+), 64 deletions(-) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 0b0c703..cd74ef8 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -73,12 +73,12 @@ If no auth-sources file, runs `mastodon-auth--generate-token-no-storing-credenti "Make POST to generate auth token, without using auth-sources file." (mastodon-http--post (concat mastodon-instance-url "/oauth/token") - `(("client_id" . ,(plist-get (mastodon-client) :client_id)) - ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) - ("grant_type" . "password") - ("username" . ,(read-string "Email: " user-mail-address)) - ("password" . ,(read-passwd "Password: ")) - ("scope" . "read write follow")) + `(("client_id" ,(plist-get (mastodon-client) :client_id)) + ("client_secret" ,(plist-get (mastodon-client) :client_secret)) + ("grant_type" "password") + ("username" ,(read-string "Email: " user-mail-address)) + ("password" ,(read-passwd "Password: ")) + ("scope" "read write follow")) nil :unauthenticated)) @@ -98,15 +98,15 @@ Reads and/or stores secrets in `MASTODON-AUTH-SOURCE-FILE'." (prog1 (mastodon-http--post (concat mastodon-instance-url "/oauth/token") - `(("client_id" . ,(plist-get (mastodon-client) :client_id)) - ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) - ("grant_type" . "password") - ("username" . ,(plist-get credentials-plist :user)) - ("password" . ,(let ((secret (plist-get credentials-plist :secret))) - (if (functionp secret) - (funcall secret) - secret))) - ("scope" . "read write follow")) + `(("client_id" ,(plist-get (mastodon-client) :client_id)) + ("client_secret" ,(plist-get (mastodon-client) :client_secret)) + ("grant_type" "password") + ("username" ,(plist-get credentials-plist :user)) + ("password" ,(let ((secret (plist-get credentials-plist :secret))) + (if (functionp secret) + (funcall secret) + secret))) + ("scope" "read write follow")) nil :unauthenticated) (when (functionp (plist-get credentials-plist :save-function)) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index bdfbca9..4503d6d 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -49,10 +49,10 @@ "POST client to Mastodon." (mastodon-http--post (mastodon-http--api "apps") - '(("client_name" . "mastodon.el") - ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") - ("scopes" . "read write follow") - ("website" . "https://github.com/jdenen/mastodon.el")) + '(("client_name" "mastodon.el") + ("redirect_uris" "urn:ietf:wg:oauth:2.0:oob") + ("scopes" "read write follow") + ("website" "https://github.com/jdenen/mastodon.el")) nil :unauthenticated)) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index bc48e8d..85ee588 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -90,29 +90,75 @@ Message status and JSON error from RESPONSE if unsuccessful." (let ((json-response (mastodon-http--process-json))) (message "Error %s: %s" status (cdr (assoc 'error json-response)))))))) +(defun mastodon-http--encode-multipart-form-data (boundary fields) + "Encode FIELDS suitable to post as multipart/form-data. + +It uses BOUNDARY as the boundary for the values. +FIELDS should be a list of either 2-element (name contents) lists +or 4-element list of (name file-name content-type contents)." + (with-temp-buffer + (dolist (field fields) + (insert "--" boundary "\r\n") + (if (= (length field) 2) + ;; a 2-element list is a simple name=value item: + (insert "Content-Disposition: form-data; name=\"" + (url-hexify-string (car field)) + "\"\r\n" + "\r\n" + (cadr field) "\r\n") + ;; a 4-element list ist a file to be attached: + (insert "Content-Disposition: form-data; name=\"" + (url-hexify-string (car field)) + "\"; filename=\"" + (url-hexify-string (cadr field)) + "\"\r\n" + "Content-type: " (caddr field) "\r\n" + "\r\n" + (cadddr field) "\r\n"))) + ;; Finally add the terminating boundary and another empty line: + (insert "--" boundary "--\r\n" + "\r\n") + (string-to-unibyte (buffer-string)))) + (defun mastodon-http--post (url args headers &optional unauthenticed-p) "POST synchronously to URL with ARGS and HEADERS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." - (let ((url-request-method "POST") - (url-request-data - (when args - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) - "=" - (url-hexify-string (cdr arg)))) - args - "&"))) + (let* ((url-request-method "POST") + (boundary (md5 (format "b%s-%s-%s-%s" + (random 1000000000) (random 1000000000) + (random 1000000000) (random 1000000000)))) + (needs-multi-form (> (apply #'max (mapcar #'length args)) 2)) + (url-request-data + (when args + (if needs-multi-form + (mastodon-http--encode-multipart-form-data boundary args) + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cadr arg)))) + args + "&")))) (url-request-extra-headers (append + (when needs-multi-form + `(("Content-Type" . + ,(concat "multipart/form-data; boundary=\"" boundary "\"")))) (unless unauthenticed-p `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))) headers))) + (message "Posting to %s with %d bytes of request data and headers %s" url (length url-request-data) url-request-extra-headers) (with-temp-buffer (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) (url-retrieve-synchronously url nil nil mastodon-http--timeout))))) +(defun mastodon-http--read-file-as-string (filename) + "" + (with-temp-buffer + (insert-file-contents filename) + (string-to-unibyte (buffer-string)))) + (defun mastodon-http--get (url) "Make synchronous GET request to URL. diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 8aadf0a..fd2a6b7 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -51,6 +51,11 @@ :group 'mastodon-media :type 'integer) +(defcustom mastodon-media--attachment-height 100 + "Height of the attached images preview." + :group 'mastodon-media + :type 'integer) + (defvar mastodon-media--generic-avatar-data (base64-decode-string "iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a8b121b..6c08859 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -30,6 +30,7 @@ ;;; Code: (defvar mastodon-instance-url) +(defvar mastodon-media--attachment-height) (when (require 'emojify nil :noerror) (declare-function emojify-insert-emoji "emojify")) @@ -103,6 +104,10 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p "Buffer-local variable to hold the id of the toot being replied to.") (make-variable-buffer-local 'mastodon-toot--reply-to-id) +(defvar mastodon-toot--media-attachments nil + "Buffer-local variable to hold the list of media attachments.") +(make-variable-buffer-local 'mastodon-toot--media-attachments) + (defvar mastodon-toot-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -110,9 +115,10 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (define-key map (kbd "C-c C-w") #'mastodon-toot--toggle-warning) (define-key map (kbd "C-c C-n") #'mastodon-toot--toggle-nsfw) (define-key map (kbd "C-c C-v") #'mastodon-toot--change-visibility) - (define-key map (kbd "C-c C-a") #'mastodon-toot--add-media-attachment) (when (require 'emojify nil :noerror) (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) + (define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media) + (define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments) map) "Keymap for `mastodon-toot'.") @@ -147,6 +153,14 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response callback)))) +(defun mastodon-toot--post-media (contents content-type description) + (let* ((url (mastodon-http--api "media")) + (response (mastodon-http--post + url + (list (list "description" description) + (list "file" "file" content-type contents))))) + response)) + (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." (interactive) @@ -414,6 +428,7 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (interactive) (setq mastodon-toot--content-nsfw (not mastodon-toot--content-nsfw)) + (message "NSFW flag is now %s" (if mastodon-toot--content-nsfw "on" "off")) (mastodon-toot--update-status-fields)) (defun mastodon-toot--change-visibility () @@ -430,6 +445,54 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." "public"))) (mastodon-toot--update-status-fields)) +(defun mastodon-toot--clear-all-attachments () + "" + (interactive) + (setq mastodon-toot--media-attachments nil) + (mastodon-toot--refresh-attachments-display) + (mastodon-toot--update-status-fields)) + +(defun mastodon-toot--attach-media (file content-type description) + "" + (interactive "fFilename: \nsContent type: \nsDescription: ") + (when (>= (length mastodon-toot--media-attachments) 4) + ;; Only a max. of 4 attachments are allowed, so pop the oldest one. + (pop mastodon-toot--media-attachments)) + (setq mastodon-toot--media-attachments + (nconc mastodon-toot--media-attachments + `(((:contents . ,(mastodon-http--read-file-as-string file)) + (:content-type . ,content-type) + (:description . ,description))))) + (mastodon-toot--refresh-attachments-display)) + +(defun mastodon-toot--refresh-attachments-display () + (let ((inhibit-read-only t) + (attachments-region (mastodon-tl--find-property-range + 'toot-attachments (point-min))) + (display-specs (mastodon-toot--format-attachments))) + (dotimes (i (- (cdr attachments-region) (car attachments-region))) + (add-text-properties (+ (car attachments-region) i) + (+ (car attachments-region) i 1) + (list 'display (or (nth i display-specs) "")))))) + +(defun mastodon-toot--format-attachments () + (or (let ((counter 0) + (image-options (when (image-type-available-p 'imagemagick) + `(:height ,mastodon-media--attachment-height)))) + (mapcan (lambda (attachment) + (let* ((data (cdr (assoc :contents attachment))) + (image (apply #'create-image data + (when image-options 'imagemagick) + t image-options)) + (type (cdr (assoc :content-type attachment))) + (description (cdr (assoc :description attachment)))) + (setq counter (1+ counter)) + (list (format "\n %d: " counter) + image + (format " \"%s\" (%s)" description type)))) + mastodon-toot--media-attachments)) + (list "None")) + ) ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () @@ -483,6 +546,10 @@ on the status of NSFW, content warning flags, media attachments, etc." divider "\n" (mastodon-toot--make-mode-docs) "\n" divider "\n" + " Attachments: " + (propertize "None " 'toot-attachments t) + "\n" + divider "\n" " " (propertize "Count" 'toot-post-counter t) @@ -515,43 +582,35 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (defun mastodon-toot--update-status-fields (&rest args) "Update the status fields in the header based on the current state." - (let ((inhibit-read-only t) - (header-region (mastodon-tl--find-property-range 'toot-post-header + (ignore-errors ;; called from after-change-functions so let's not leak errors + (let ((inhibit-read-only t) + (header-region (mastodon-tl--find-property-range 'toot-post-header + (point-min))) + (count-region (mastodon-tl--find-property-range 'toot-post-counter (point-min))) - (count-region (mastodon-tl--find-property-range 'toot-post-counter + (visibility-region (mastodon-tl--find-property-range + 'toot-post-visibility (point-min))) + (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag (point-min))) - (visibility-region (mastodon-tl--find-property-range - 'toot-post-visibility (point-min))) - (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag - (point-min))) - (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag - (point-min))) - (attachment-region (mastodon-tl--find-property-range - 'toot-attachment (point-min)))) - (add-text-properties (car count-region) (cdr count-region) - (list 'display - (format "%s characters" - (- (point-max) (cdr header-region))))) - (add-text-properties (car visibility-region) (cdr visibility-region) - (list 'display - (format "Visibility: %s" - (if (equal - mastodon-toot--visibility - "private") - "followers-only" - mastodon-toot--visibility)))) - (add-text-properties (car attachment-region) (cdr attachment-region) - (list 'display - (format "Attached: %s" - (mapconcat 'identity - mastodon-toot--media-attachment-filenames - ", ")))) - (add-text-properties (car nsfw-region) (cdr nsfw-region) - (list 'invisible (not mastodon-toot--content-nsfw) - 'face 'mastodon-cw-face)) - (add-text-properties (car cw-region) (cdr cw-region) - (list 'invisible (not mastodon-toot--content-warning) - 'face 'mastodon-cw-face)))) + (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag + (point-min)))) + (add-text-properties (car count-region) (cdr count-region) + (list 'display + (format "%s characters in message" + (- (point-max) (cdr header-region))))) + (add-text-properties (car visibility-region) (cdr visibility-region) + (list 'display + (format "Visibility: %s" + mastodon-toot--visibility))) + (add-text-properties (car nsfw-region) (cdr nsfw-region) + (list 'display (if mastodon-toot--content-nsfw + (if mastodon-toot--media-attachments + "NSFW" "NSFW (no effect until attachments added)") + "") + 'face 'mastodon-cw-face)) + (add-text-properties (car cw-region) (cdr cw-region) + (list 'invisible (not mastodon-toot--content-warning) + 'face 'mastodon-cw-face))))) (defun mastodon-toot--compose-buffer (reply-to-user reply-to-id) "Create a new buffer to capture text for a new toot. @@ -561,12 +620,14 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (buffer (or buffer-exists (get-buffer-create "*new toot*"))) (inhibit-read-only t)) (switch-to-buffer-other-window buffer) + (mastodon-toot-mode t) (when (not buffer-exists) (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) (mastodon-toot-mode t) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) + (mastodon-toot--refresh-attachments-display) (mastodon-toot--update-status-fields))) (define-minor-mode mastodon-toot-mode -- cgit v1.2.3 From 72c14d797fe3848429b64812fb7145d11253fc88 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 13:13:38 +0200 Subject: handle image scaling with image-transforms-p (when emacs >= 27.1) --- lisp/mastodon-toot.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6c08859..1afad8a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -477,12 +477,15 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (defun mastodon-toot--format-attachments () (or (let ((counter 0) - (image-options (when (image-type-available-p 'imagemagick) + (image-options (when (or (image-type-available-p 'imagemagick) + (image-transforms-p)) `(:height ,mastodon-media--attachment-height)))) (mapcan (lambda (attachment) (let* ((data (cdr (assoc :contents attachment))) (image (apply #'create-image data - (when image-options 'imagemagick) + (if (version< emacs-version "27.1") + (when image-options 'imagemagick) + nil) ; inbuilt scaling in 27.1 t image-options)) (type (cdr (assoc :content-type attachment))) (description (cdr (assoc :description attachment)))) @@ -491,8 +494,8 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." image (format " \"%s\" (%s)" description type)))) mastodon-toot--media-attachments)) - (list "None")) - ) + (list "None"))) + ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () @@ -596,7 +599,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (point-min)))) (add-text-properties (car count-region) (cdr count-region) (list 'display - (format "%s characters in message" + (format "%s characters" (- (point-max) (cdr header-region))))) (add-text-properties (car visibility-region) (cdr visibility-region) (list 'display -- cgit v1.2.3 From 13064aa96e0152da0dfbe93e5349aaef61646731 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 14:51:32 +0200 Subject: revert "private" visibility = "followers only" in toot draft --- lisp/mastodon-toot.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 1afad8a..5b7d537 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -602,9 +602,13 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (format "%s characters" (- (point-max) (cdr header-region))))) (add-text-properties (car visibility-region) (cdr visibility-region) - (list 'display - (format "Visibility: %s" - mastodon-toot--visibility))) + (list 'display + (format "Visibility: %s" + (if (equal + mastodon-toot--visibility + "private") + "followers-only" + mastodon-toot--visibility)))) (add-text-properties (car nsfw-region) (cdr nsfw-region) (list 'display (if mastodon-toot--content-nsfw (if mastodon-toot--media-attachments -- cgit v1.2.3 From ff76a83fc57817731c407da3cf8a6ef6a71434c5 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 14:59:03 +0200 Subject: revert mastodon-http changes - we will keep my old implementation of attachment uploading, as it already works with the media_ids[] of the API. --- lisp/mastodon-http.el | 58 ++++++++------------------------------------------- 1 file changed, 9 insertions(+), 49 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 85ee588..052218c 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -90,64 +90,24 @@ Message status and JSON error from RESPONSE if unsuccessful." (let ((json-response (mastodon-http--process-json))) (message "Error %s: %s" status (cdr (assoc 'error json-response)))))))) -(defun mastodon-http--encode-multipart-form-data (boundary fields) - "Encode FIELDS suitable to post as multipart/form-data. - -It uses BOUNDARY as the boundary for the values. -FIELDS should be a list of either 2-element (name contents) lists -or 4-element list of (name file-name content-type contents)." - (with-temp-buffer - (dolist (field fields) - (insert "--" boundary "\r\n") - (if (= (length field) 2) - ;; a 2-element list is a simple name=value item: - (insert "Content-Disposition: form-data; name=\"" - (url-hexify-string (car field)) - "\"\r\n" - "\r\n" - (cadr field) "\r\n") - ;; a 4-element list ist a file to be attached: - (insert "Content-Disposition: form-data; name=\"" - (url-hexify-string (car field)) - "\"; filename=\"" - (url-hexify-string (cadr field)) - "\"\r\n" - "Content-type: " (caddr field) "\r\n" - "\r\n" - (cadddr field) "\r\n"))) - ;; Finally add the terminating boundary and another empty line: - (insert "--" boundary "--\r\n" - "\r\n") - (string-to-unibyte (buffer-string)))) - (defun mastodon-http--post (url args headers &optional unauthenticed-p) "POST synchronously to URL with ARGS and HEADERS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." - (let* ((url-request-method "POST") - (boundary (md5 (format "b%s-%s-%s-%s" - (random 1000000000) (random 1000000000) - (random 1000000000) (random 1000000000)))) - (needs-multi-form (> (apply #'max (mapcar #'length args)) 2)) - (url-request-data - (when args - (if needs-multi-form - (mastodon-http--encode-multipart-form-data boundary args) - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) - "=" - (url-hexify-string (cadr arg)))) - args - "&")))) + (let ((url-request-method "POST") + (url-request-data + (when args + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cdr arg)))) + args + "&"))) (url-request-extra-headers (append - (when needs-multi-form - `(("Content-Type" . - ,(concat "multipart/form-data; boundary=\"" boundary "\"")))) (unless unauthenticed-p `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))) headers))) - (message "Posting to %s with %d bytes of request data and headers %s" url (length url-request-data) url-request-extra-headers) (with-temp-buffer (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) -- cgit v1.2.3 From 6b2207251c9b44cd47cc03c8f9a68970e123c5d6 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:00:21 +0200 Subject: merge hdurers attachment upload and my own replace hdurer's mastodon-toot--post-media and my mastodon-toot--add-media-attachment with hdurer's mastodon-toot--attach-media (which holds the data in the toot draft) and my mastodon-toot--upload-media-attachments (which actually uploads them) --- lisp/mastodon-toot.el | 48 +++++++++++++++++++++--------------------------- 1 file changed, 21 insertions(+), 27 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5b7d537..7407a7c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -89,7 +89,7 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (make-variable-buffer-local 'mastodon-toot--visibility) (defvar mastodon-toot--media-attachments nil - "A flag indicating if the toot being composed has media attachments.") + "A list of the media attachments of the toot being composed .") (make-variable-buffer-local 'mastodon-toot--media-attachments) (defvar mastodon-toot--media-attachment-ids nil @@ -153,14 +153,6 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response callback)))) -(defun mastodon-toot--post-media (contents content-type description) - (let* ((url (mastodon-http--api "media")) - (response (mastodon-http--post - url - (list (list "description" description) - (list "file" "file" content-type contents))))) - response)) - (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." (interactive) @@ -314,19 +306,6 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (setq mastodon-toot--visibility visibility) (message "Visibility set to %s" visibility)) -(defun mastodon-toot--add-media-attachment () - "Prompt the user for a file and POST it to the media endpoint on the server. - -Set `mastodon-toot--media-attachment-ids' to the item's id so it can be attached to the toot." - (interactive) - (let* ((filename (read-file-name "Choose file to attach to this toot: " - mastodon-toot--default-media-directory)) - (caption (read-string "Enter a caption: ")) - (url (concat mastodon-instance-url "/api/v1/media"))) - (message "Uploading %s..." (file-name-nondirectory filename)) - (mastodon-http--post-media-attachment url filename caption) - (setq mastodon-toot--media-attachments t))) - (defun mastodon-toot--send () "Kill new-toot buffer/window and POST contents to the Mastodon instance. @@ -357,11 +336,11 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (message "Looks like your uploads are not yet ready...") (if empty-toot-p (message "Empty toot. Cowardly refusing to post this.") - (let ((response (mastodon-http--post endpoint args nil))) + (let ((response (mastodon-http--post endpoint args nil))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) - (message "Toot toot!")))))))) + (message "Toot toot!"))))))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -446,14 +425,16 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (mastodon-toot--update-status-fields)) (defun mastodon-toot--clear-all-attachments () - "" + "Remove all attachments from a toot draft." (interactive) (setq mastodon-toot--media-attachments nil) (mastodon-toot--refresh-attachments-display) (mastodon-toot--update-status-fields)) (defun mastodon-toot--attach-media (file content-type description) - "" + "Prompt for a attachment FILE of CONTENT-TYPE with DESCRIPTION. +A preview is displayed in the toot create buffer, and the file +will be uploaded and attached to the toot upon sending." (interactive "fFilename: \nsContent type: \nsDescription: ") (when (>= (length mastodon-toot--media-attachments) 4) ;; Only a max. of 4 attachments are allowed, so pop the oldest one. @@ -462,9 +443,22 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (nconc mastodon-toot--media-attachments `(((:contents . ,(mastodon-http--read-file-as-string file)) (:content-type . ,content-type) - (:description . ,description))))) + (:description . ,description) + (:filename . ,(file-name-nondirectory file)))))) (mastodon-toot--refresh-attachments-display)) +(defun mastodon-toot--upload-media-attachments () + "Actually upload the attachment files using `mastodon-http--post-media-attachment'. +It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used to actually attach them to a toot after uploading." + (interactive) + (mapcar (lambda (attachment) + (let* ((filename (cdr (assoc :filename attachment))) + (caption (cdr (assoc :description attachment))) + (url (concat mastodon-instance-url "/api/v1/media"))) + (message "Uploading %s..." filename) + (mastodon-http--post-media-attachment url filename caption))) + mastodon-toot--media-attachments)) + (defun mastodon-toot--refresh-attachments-display () (let ((inhibit-read-only t) (attachments-region (mastodon-tl--find-property-range -- cgit v1.2.3 From e93adbde20d8f8f0d0e3810ebc3f1890d362dae4 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:10:13 +0200 Subject: rever auth / client changes too --- lisp/mastodon-auth.el | 18 +++++++++--------- lisp/mastodon-client.el | 8 ++++---- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index cd74ef8..6729e81 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -98,15 +98,15 @@ Reads and/or stores secrets in `MASTODON-AUTH-SOURCE-FILE'." (prog1 (mastodon-http--post (concat mastodon-instance-url "/oauth/token") - `(("client_id" ,(plist-get (mastodon-client) :client_id)) - ("client_secret" ,(plist-get (mastodon-client) :client_secret)) - ("grant_type" "password") - ("username" ,(plist-get credentials-plist :user)) - ("password" ,(let ((secret (plist-get credentials-plist :secret))) - (if (functionp secret) - (funcall secret) - secret))) - ("scope" "read write follow")) + `(("client_id" . ,(plist-get (mastodon-client) :client_id)) + ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) + ("grant_type" . "password") + ("username" . ,(plist-get credentials-plist :user)) + ("password" . ,(let ((secret (plist-get credentials-plist :secret))) + (if (functionp secret) + (funcall secret) + secret))) + ("scope" . "read write follow")) nil :unauthenticated) (when (functionp (plist-get credentials-plist :save-function)) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index 4503d6d..bdfbca9 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -49,10 +49,10 @@ "POST client to Mastodon." (mastodon-http--post (mastodon-http--api "apps") - '(("client_name" "mastodon.el") - ("redirect_uris" "urn:ietf:wg:oauth:2.0:oob") - ("scopes" "read write follow") - ("website" "https://github.com/jdenen/mastodon.el")) + '(("client_name" . "mastodon.el") + ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") + ("scopes" . "read write follow") + ("website" . "https://github.com/jdenen/mastodon.el")) nil :unauthenticated)) -- cgit v1.2.3 From 9564994df6ade898831789200d3ac133ba9de07e Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:19:20 +0200 Subject: flycheck toot.el --- lisp/mastodon-toot.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7407a7c..a040efc 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -50,6 +50,7 @@ (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-http--post-media-attachment "mastodon-http") +(autoload 'mastodon-http--read-file-as-string "mastodon-http") (autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") @@ -331,9 +332,9 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) (args (append args-no-media args-media))) - (if (and mastodon-toot--media-attachments + (when (and mastodon-toot--media-attachments (equal mastodon-toot--media-attachment-ids nil)) - (message "Looks like your uploads are not yet ready...") + (message "Looks like your uploads are not yet ready...")) (if empty-toot-p (message "Empty toot. Cowardly refusing to post this.") (let ((response (mastodon-http--post endpoint args nil))) @@ -448,7 +449,7 @@ will be uploaded and attached to the toot upon sending." (mastodon-toot--refresh-attachments-display)) (defun mastodon-toot--upload-media-attachments () - "Actually upload the attachment files using `mastodon-http--post-media-attachment'. + "Actually upload attachments using `mastodon-http--post-media-attachment'. It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used to actually attach them to a toot after uploading." (interactive) (mapcar (lambda (attachment) @@ -460,6 +461,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t mastodon-toot--media-attachments)) (defun mastodon-toot--refresh-attachments-display () + "Display attachment previews in toot draft buffer." (let ((inhibit-read-only t) (attachments-region (mastodon-tl--find-property-range 'toot-attachments (point-min))) @@ -470,6 +472,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t (list 'display (or (nth i display-specs) "")))))) (defun mastodon-toot--format-attachments () + "Format the attachment previews in toot draft buffer." (or (let ((counter 0) (image-options (when (or (image-type-available-p 'imagemagick) (image-transforms-p)) -- cgit v1.2.3 From 46a2f82edf61b370aa5e8432a4f3f17614293e25 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:27:22 +0200 Subject: disambiguate media--attachment-height and preview-max-height --- lisp/mastodon-media.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index fd2a6b7..28fbd19 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -47,12 +47,12 @@ :type 'integer) (defcustom mastodon-media--preview-max-height 250 - "Max height of any media attachment preview to be shown." + "Max height of any media attachment preview to be shown in timelines." :group 'mastodon-media :type 'integer) -(defcustom mastodon-media--attachment-height 100 - "Height of the attached images preview." +(defcustom mastodon-media--attachment-height 80 + "Height of the attached images preview in the toot draft buffer." :group 'mastodon-media :type 'integer) -- cgit v1.2.3 From 1f25073c25ae6c8e44c72028fbf873f24544b8e9 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:27:51 +0200 Subject: remove my old attachment display --- lisp/mastodon-toot.el | 3 --- 1 file changed, 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a040efc..8dfe00b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -557,9 +557,6 @@ on the status of NSFW, content warning flags, media attachments, etc." (propertize "Visibility" 'toot-post-visibility t) " ⋅ " - (propertize "Attachment" - 'toot-attachment t) - " ⋅ " (propertize "CW" 'toot-post-cw-flag t) " " -- cgit v1.2.3 From 1ccf12b34c14c3cc5c58ccf214865b3af1719d54 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 17:13:47 +0200 Subject: binding to upload media, and check uploads up before posting toot --- lisp/mastodon-toot.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8dfe00b..86cecfd 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -118,6 +118,7 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (define-key map (kbd "C-c C-v") #'mastodon-toot--change-visibility) (when (require 'emojify nil :noerror) (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) + (define-key map (kbd "C-c C-u") #'mastodon-toot--upload-attached-media) (define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media) (define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments) map) @@ -332,16 +333,16 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) (args (append args-no-media args-media))) - (when (and mastodon-toot--media-attachments + (if (and mastodon-toot--media-attachments (equal mastodon-toot--media-attachment-ids nil)) - (message "Looks like your uploads are not yet ready...")) + (message "Looks like your uploads are not up: C-c C-u to upload...") (if empty-toot-p (message "Empty toot. Cowardly refusing to post this.") (let ((response (mastodon-http--post endpoint args nil))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) - (message "Toot toot!"))))))) + (message "Toot toot!")))))))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -448,7 +449,7 @@ will be uploaded and attached to the toot upon sending." (:filename . ,(file-name-nondirectory file)))))) (mastodon-toot--refresh-attachments-display)) -(defun mastodon-toot--upload-media-attachments () +(defun mastodon-toot--upload-attached-media () "Actually upload attachments using `mastodon-http--post-media-attachment'. It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used to actually attach them to a toot after uploading." (interactive) -- cgit v1.2.3 From 765da49f980673863b09a814630646c8044c96ad Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 17:14:13 +0200 Subject: FIX the filename we send to post-media-attachement - it needs to be with full path of course! --- 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 86cecfd..c00e4bf 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -446,7 +446,7 @@ will be uploaded and attached to the toot upon sending." `(((:contents . ,(mastodon-http--read-file-as-string file)) (:content-type . ,content-type) (:description . ,description) - (:filename . ,(file-name-nondirectory file)))))) + (:filename . ,file))))) (mastodon-toot--refresh-attachments-display)) (defun mastodon-toot--upload-attached-media () @@ -457,9 +457,9 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t (let* ((filename (cdr (assoc :filename attachment))) (caption (cdr (assoc :description attachment))) (url (concat mastodon-instance-url "/api/v1/media"))) - (message "Uploading %s..." filename) + (message "Uploading %s..." (file-name-nondirectory filename)) (mastodon-http--post-media-attachment url filename caption))) - mastodon-toot--media-attachments)) + mastodon-toot--media-attachments)) (defun mastodon-toot--refresh-attachments-display () "Display attachment previews in toot draft buffer." -- cgit v1.2.3 From e0cabe76d4107610c44b1bc6c570840ebadb5467 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 18:47:52 +0200 Subject: docstrings --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c00e4bf..ec5a8ac 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -462,7 +462,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t mastodon-toot--media-attachments)) (defun mastodon-toot--refresh-attachments-display () - "Display attachment previews in toot draft buffer." + "Update the display attachment previews in toot draft buffer." (let ((inhibit-read-only t) (attachments-region (mastodon-tl--find-property-range 'toot-attachments (point-min))) @@ -473,7 +473,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t (list 'display (or (nth i display-specs) "")))))) (defun mastodon-toot--format-attachments () - "Format the attachment previews in toot draft buffer." + "Format the attachment previews for display in toot draft buffer." (or (let ((counter 0) (image-options (when (or (image-type-available-p 'imagemagick) (image-transforms-p)) -- cgit v1.2.3 From f0dbd664537bab060f2b4d8b7f1d6e439f6a2530 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 14 Oct 2021 12:34:17 +0200 Subject: readme --- README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.org b/README.org index 60f04eb..dcccccf 100644 --- a/README.org +++ b/README.org @@ -70,10 +70,10 @@ I might add a few more features if the ones I added turn out to work ok. Possibl - [X] prevent loss of draft toots by the toot-send bug - [X] fix scaling of images - [ ] display post visibility status in timelines +- [ ] caching of images / avatars - better display of polls - display number of boosts/faves in toot byline - mention all thread participants in replies -- handle newlines in toots better, for poetry, etc. - improve (or even partially disable) async. It looks like 2-factor auth was never completed in the original repo. It's not a priority for me, auth ain't my thing. If you want to hack on it, its on the develop branch in the original repo. -- cgit v1.2.3 From 7bcf78751c7e0f8ac6d5ad03be8e87e8ed30f9a3 Mon Sep 17 00:00:00 2001 From: mousebot Date: Mon, 18 Oct 2021 20:54:03 +0200 Subject: Revert "handle cached images" -- caching images with url.el locks up mastodon.el This reverts commit 0129bcf466a4913bdda095b977cd06560c406a30. --- lisp/mastodon-media.el | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 8ef9c44..b58eab6 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -189,15 +189,9 @@ REGION-LENGTH is the range from start to propertize." (condition-case nil ;; catch any errors in url-retrieve so as to not abort ;; whatever called us - (if (url-is-cached url) - (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-retrieve url - #'mastodon-media--process-image-response - (list marker image-options region-length))) + (url-retrieve url + #'mastodon-media--process-image-response + (list marker image-options region-length)) (error (with-current-buffer buffer ;; TODO: Consider adding retries (put-text-property marker @@ -205,7 +199,7 @@ REGION-LENGTH is the range from start to propertize." 'media-state 'loading-failed) :loading-failed)))))) -H + (defun mastodon-media--select-next-media-line (end-pos) "Find coordinates of the next media to load before END-POS. -- cgit v1.2.3 From 1d94efdb2de1238cde0673d07e8268ff821ab815 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 20 Oct 2021 14:41:10 +0200 Subject: first go at company completion for mentions in new toots --- lisp/mastodon-search.el | 19 ++++++++++++++++++ lisp/mastodon-toot.el | 53 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 537a746..14e40d8 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -43,6 +43,25 @@ (defvar mastodon-tl--link-keymap) (defvar mastodon-http--timeout) +;; functions for company completion of mentions in mastodon-toot + +(defun mastodon-search--get-user-info-no-url (account) + "Get user handle, display name and account URL from ACCOUNT." + (list (cdr (assoc 'display_name account)) + (cdr (assoc 'acct account)))) + +(defun mastodon-search--search-accounts-query (query) + "Prompt for a search QUERY and return accounts. +Returns a nested list containing user handle, display name, and URL." + (interactive "sSearch mastodon for: ") + (let* ((url (format "%s/api/v1/accounts/search" mastodon-instance-url)) + (buffer (format "*mastodon-search-%s*" query)) + (response (mastodon-http--get-search-json url query))) + (mapcar #'mastodon-search--get-user-info-no-url ;-handle-flat-propertized + response))) + +;; functions for mastodon search + (defun mastodon-search--search-query (query) "Prompt for a search QUERY and return accounts, statuses, and hashtags." (interactive "sSearch mastodon for: ") diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a8b121b..f3cbfb0 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -34,6 +34,9 @@ (when (require 'emojify nil :noerror) (declare-function emojify-insert-emoji "emojify")) +(require 'cl-lib) +(require 'company nil :noerror) + (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") @@ -51,6 +54,7 @@ (autoload 'mastodon-http--post-media-attachment "mastodon-http") (autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") +(autoload 'mastodon-search--search-accounts-query "mastodon-search") (defgroup mastodon-toot nil "Tooting in Mastodon." @@ -73,6 +77,12 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" :group 'mastodon-toot :type 'string) +(when (require 'company nil :noerror) + (defcustom mastodon-toot--use-company-completion-for-mentions t + "Whether to enable company completion for mentions in toot compose buffer." + :group 'mastodon-toot + :type 'boolean)) + (defvar mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") (make-variable-buffer-local 'mastodon-toot--content-warning) @@ -376,6 +386,46 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (reverse (append mentions nil)) ""))) +;; (defun mastodon-toot--mentions-company-meta (candidate) +;; (format "meta %s of candidate %s" +;; (get-text-property 0 'meta candidate) +;; (substring-no-properties candidate))) + +(defun mastodon-toot--mentions-company-annotation (candidate) + "Construct a company completion CANDIDATE's annotation for display." + (format " %s" (get-text-property 0 'meta candidate))) + +(defun mastodon-toot--mentions-company-candidates (prefix) + "Given a company PREFIX, build a list of candidates. +The prefix string is tested against both user handles and display names." + (let (res) + (dolist (item (mastodon-search--search-accounts-query prefix)) + (when (or (string-prefix-p prefix (cadr item)) + (string-prefix-p prefix (car item))) + (push (mastodon-toot--mentions-company-make-candidate item) res))) + res)) + +(defun mastodon-toot--mentions-company-make-candidate (candidate) + "Construct a company completion CANDIDATE for display." + (let ((display-name (car candidate)) + (handle (cadr candidate))) + (propertize handle 'meta display-name))) + +(defun mastodon-toot--mentions-company-backend (command &optional arg &rest ignored) + "A company completion backend for toot mentions." + (interactive (list 'interactive)) + (cl-case command + (interactive (company-begin-backend 'mastodon-toot--mentions-company-backend)) + (prefix (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode + (save-excursion + (backward-word) + (backward-char) + (looking-at "@")) ; if we have a mention + (company-grab-symbol))) ;; get thing before point, sans @ + (candidates (mastodon-toot--mentions-company-candidates arg)) + (annotation (mastodon-toot--mentions-company-annotation arg)))) + ;; (meta (mastodon-toot--mentions-company-meta arg)))) + (defun mastodon-toot--reply () "Reply to toot at `point'." (interactive) @@ -565,6 +615,9 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) (mastodon-toot-mode t) + (when mastodon-toot--use-company-completion-for-mentions + (add-to-list 'company-backends 'mastodon-toot--mentions-company-backend) + (company-mode-on)) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--update-status-fields))) -- cgit v1.2.3 From b74f24d483d3f7a478fc93eae21aa8c1e6154e24 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 20 Oct 2021 15:16:21 +0200 Subject: revert leftover caching things from merging image-previews branch --- lisp/mastodon-media.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 3016d33..a401de5 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -135,7 +135,7 @@ fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=") "The PNG data for a generic 200x200 'broken image' view.") (defun mastodon-media--process-image-response - (status-plist marker image-options region-length url) + (status-plist marker image-options region-length) "Callback function processing the url retrieve response for URL. STATUS-PLIST is the usual plist of status events as per `url-retrieve'. @@ -156,8 +156,6 @@ REGION-LENGTH is the length of the region that should be replaced with the image (when image-options 'imagemagick) nil) ; inbuilt scaling in 27.1 t image-options)))) - (unless (url-is-cached url) ; cache image if not already cached - (url-store-in-cache url-buffer)) (with-current-buffer (marker-buffer marker) ;; Save narrowing in our buffer (let ((inhibit-read-only t)) -- cgit v1.2.3 From 0854bc834d5fe35a241d8dc2339721635de2c00e Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 20 Oct 2021 15:37:14 +0200 Subject: revert hdurers alist > plist conv in auth.el --- lisp/mastodon-auth.el | 12 ++++++------ lisp/mastodon-http.el | 6 ------ 2 files changed, 6 insertions(+), 12 deletions(-) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 6729e81..0b0c703 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -73,12 +73,12 @@ If no auth-sources file, runs `mastodon-auth--generate-token-no-storing-credenti "Make POST to generate auth token, without using auth-sources file." (mastodon-http--post (concat mastodon-instance-url "/oauth/token") - `(("client_id" ,(plist-get (mastodon-client) :client_id)) - ("client_secret" ,(plist-get (mastodon-client) :client_secret)) - ("grant_type" "password") - ("username" ,(read-string "Email: " user-mail-address)) - ("password" ,(read-passwd "Password: ")) - ("scope" "read write follow")) + `(("client_id" . ,(plist-get (mastodon-client) :client_id)) + ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) + ("grant_type" . "password") + ("username" . ,(read-string "Email: " user-mail-address)) + ("password" . ,(read-passwd "Password: ")) + ("scope" . "read write follow")) nil :unauthenticated)) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 052218c..bc48e8d 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -113,12 +113,6 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (url-retrieve-synchronously url) (url-retrieve-synchronously url nil nil mastodon-http--timeout))))) -(defun mastodon-http--read-file-as-string (filename) - "" - (with-temp-buffer - (insert-file-contents filename) - (string-to-unibyte (buffer-string)))) - (defun mastodon-http--get (url) "Make synchronous GET request to URL. -- cgit v1.2.3 From cd2497074c9d44f9fe302aaf3696a79acd93ece8 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 11:24:09 +0200 Subject: make add mentions-company-backend to company-backens buffer local - we add to company-backends rather than replacing it, but it is still only buffer local. --- lisp/mastodon-toot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4215dec..6f2f8e4 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -678,7 +678,8 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) (mastodon-toot-mode t) (when mastodon-toot--use-company-completion-for-mentions - (add-to-list 'company-backends 'mastodon-toot--mentions-company-backend) + (set (make-local-variable 'company-backends) + (add-to-list 'company-backends 'mastodon-toot--mentions-company-backend)) (company-mode-on)) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) -- cgit v1.2.3 From a3361877511dbb573ef470caaec78cb9595cffbc Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 14:33:33 +0200 Subject: fix default-toot-visibility customize --- lisp/mastodon-toot.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6f2f8e4..da559ef 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -68,11 +68,11 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \"direct\"." :group 'mastodon-toot - :type 'choice - :options '("public" - "unlisted" - "private" - "direct")) + :type '(choice + (const :tag "public" "public") + (const :tag "unlisted" "unlisted") + (const :tag "followers only" "private") + (const :tag "direct" "direct"))) (defcustom mastodon-toot--default-media-directory "~/" "The default directory when prompting for a media file to upload." -- cgit v1.2.3 From 156b32132f78ede03e3e6188ecf3bf67790b6846 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 14:34:06 +0200 Subject: remove empty lines from docstrings --- lisp/mastodon-http.el | 6 ------ 1 file changed, 6 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index bc48e8d..2d91840 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -192,9 +192,7 @@ Pass response buffer to CALLBACK function." ;; hard coded just for bio note for now: (defun mastodon-http--patch (base-url &optional note) "Make synchronous PATCH request to BASE-URL. - Optionally specify the NOTE to edit. - Pass response buffer to CALLBACK function." (let ((url-request-method "PATCH") (url (if note @@ -211,7 +209,6 @@ Pass response buffer to CALLBACK function." (defun mastodon-http--get-async (url &optional callback &rest cbargs) "Make GET request to URL. - Pass response buffer to CALLBACK function with args CBARGS." (let ((url-request-method "GET") (url-request-extra-headers @@ -229,9 +226,7 @@ Pass response buffer to CALLBACK function with args CBARGS." (defun mastodon-http--post-async (url args headers &optional callback &rest cbargs) "POST asynchronously to URL with ARGS and HEADERS. - Then run function CALLBACK with arguements CBARGS. - Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (let ((url-request-method "POST") (request-timeout 5) @@ -252,7 +247,6 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." ;; TODO: test for curl first? (defun mastodon-http--post-media-attachment (url filename caption) "Make POST request to upload FILENAME with CAPTION to the server's media URL. - The upload is asynchronous. On succeeding, `mastodon-toot--media-attachment-ids' is set to the id(s) of the item uploaded, and `mastodon-toot--update-status-fields' is run." (let* ((file (file-name-nondirectory filename)) (request-backend 'curl)) -- cgit v1.2.3 From c08bc9dea693388a779d5702fc6cc421353bb889 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 14:35:40 +0200 Subject: improvements to toot mentions completion - customize option for completion off, following-only, or all. - 'following=true' is forwarded to http--get-search accordingly. - use company-grab-symbol-cons + regex, prepend "@" to it - also prepend '@' to the list in get-user-info-no-url - this makes company display user handles prepended with '@', and to match and - enter a handle without duplicating the '@' --- lisp/mastodon-http.el | 14 ++++++++------ lisp/mastodon-search.el | 8 +++++--- lisp/mastodon-toot.el | 23 +++++++++++------------ 3 files changed, 24 insertions(+), 21 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 2d91840..fbcf855 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -163,18 +163,20 @@ Pass response buffer to CALLBACK function." (kill-buffer) (json-read-from-string json-string))) -(defun mastodon-http--get-search-json (url query) +(defun mastodon-http--get-search-json (url query &optional param) "Make GET request to URL, searching for QUERY and return JSON response." - (let ((buffer (mastodon-http--get-search url query))) + (let ((buffer (mastodon-http--get-search url query param))) (with-current-buffer buffer (mastodon-http--process-json-search)))) -(defun mastodon-http--get-search (base-url query) +(defun mastodon-http--get-search (base-url query &optional param) "Make GET request to BASE-URL, searching for QUERY. - -Pass response buffer to CALLBACK function." +Pass response buffer to CALLBACK function. +PARAM is a formatted request parameter, eg 'following=true'." (let ((url-request-method "GET") - (url (concat base-url "?q=" (url-hexify-string query))) + (url (if param + (concat base-url "?" param "&q=" (url-hexify-string query)) + (concat base-url "?q=" (url-hexify-string query)))) (url-request-extra-headers `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))))) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 14e40d8..40f134d 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -48,7 +48,7 @@ (defun mastodon-search--get-user-info-no-url (account) "Get user handle, display name and account URL from ACCOUNT." (list (cdr (assoc 'display_name account)) - (cdr (assoc 'acct account)))) + (concat "@" (cdr (assoc 'acct account))))) (defun mastodon-search--search-accounts-query (query) "Prompt for a search QUERY and return accounts. @@ -56,8 +56,10 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (format "%s/api/v1/accounts/search" mastodon-instance-url)) (buffer (format "*mastodon-search-%s*" query)) - (response (mastodon-http--get-search-json url query))) - (mapcar #'mastodon-search--get-user-info-no-url ;-handle-flat-propertized + (response (if (equal mastodon-toot--enable-completion-for-mentions "followers") + (mastodon-http--get-search-json url query "following=true") + (mastodon-http--get-search-json url query)))) + (mapcar #'mastodon-search--get-user-info-no-url response))) ;; functions for mastodon search diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index da559ef..51c2431 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -80,10 +80,13 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" :type 'string) (when (require 'company nil :noerror) - (defcustom mastodon-toot--use-company-completion-for-mentions t + (defcustom mastodon-toot--enable-completion-for-mentions "followers" "Whether to enable company completion for mentions in toot compose buffer." :group 'mastodon-toot - :type 'boolean)) + :type '(choice + (const :tag "off" nil) + (const :tag "followers only" "followers") + (const :tag "all users" "all")))) (defvar mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") @@ -406,20 +409,16 @@ The prefix string is tested against both user handles and display names." (handle (cadr candidate))) (propertize handle 'meta display-name))) -(defun mastodon-toot--mentions-company-backend (command &optional arg &rest ignored) +(defun mastodon-toot--mentions-completion (command &optional arg &rest ignored) "A company completion backend for toot mentions." (interactive (list 'interactive)) (cl-case command - (interactive (company-begin-backend 'mastodon-toot--mentions-company-backend)) + (interactive (company-begin-backend 'mastodon-toot--mentions-completion)) (prefix (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode - (save-excursion - (backward-word) - (backward-char) - (looking-at "@")) ; if we have a mention - (company-grab-symbol))) ;; get thing before point, sans @ + ;; @ + thing before point + (concat "@" (company-grab-symbol-cons "^@[0-9A-Za-z-.\\_@]+" 2)))) (candidates (mastodon-toot--mentions-company-candidates arg)) (annotation (mastodon-toot--mentions-company-annotation arg)))) - ;; (meta (mastodon-toot--mentions-company-meta arg)))) (defun mastodon-toot--reply () "Reply to toot at `point'." @@ -677,9 +676,9 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) (mastodon-toot-mode t) - (when mastodon-toot--use-company-completion-for-mentions + (when mastodon-toot--enable-completion-for-mentions (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot--mentions-company-backend)) + (add-to-list 'company-backends 'mastodon-toot--mentions-completion)) (company-mode-on)) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) -- cgit v1.2.3 From 299356ebee27abb8b97cdd4546164b9918727844 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 15:28:27 +0200 Subject: replies to toots adopt their visibility status by default. this makes it so that if you reply to a direct message, your toot will also be direct by default. - we feed the reply's full toot JSON through the chain of functions called, all the way down to "setup-as-reply". that way, if anything else needs to be extracted when setting up a reply, it's all there. --- lisp/mastodon-toot.el | 18 +++++++++++------- lisp/mastodon.el | 5 ++--- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 51c2431..fa44645 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -444,7 +444,7 @@ The prefix string is tested against both user handles and display names." mentions)) (concat (mastodon-toot--process-local user) mentions))) - id))) + id toot))) (defun mastodon-toot--toggle-warning () "Toggle `mastodon-toot--content-warning'." @@ -620,12 +620,16 @@ on the status of NSFW, content warning flags, media attachments, etc." 'read-only "Edit your message below." 'toot-post-header t)))) -(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id) +(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id reply-json) "If REPLY-TO-USER is provided, inject their handle into the message. If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." - (when reply-to-user - (insert (format "%s " reply-to-user)) - (setq mastodon-toot--reply-to-id reply-to-id))) + (let ((reply-visibility (cdr (assoc 'visibility reply-json)))) + (when reply-to-user + (insert (format "%s " reply-to-user)) + (setq mastodon-toot--reply-to-id reply-to-id) + (if (not (equal mastodon-toot--visibility + reply-visibility)) + (setq mastodon-toot--visibility reply-visibility))))) (defun mastodon-toot--update-status-fields (&rest args) "Update the status fields in the header based on the current state." @@ -663,7 +667,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (list 'invisible (not mastodon-toot--content-warning) 'face 'mastodon-cw-face))))) -(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id) +(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id reply-json) "Create a new buffer to capture text for a new toot. If REPLY-TO-USER is provided, inject their handle into the message. If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." @@ -674,7 +678,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (mastodon-toot-mode t) (when (not buffer-exists) (mastodon-toot--display-docs-and-status-fields) - (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) + (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json)) (mastodon-toot-mode t) (when mastodon-toot--enable-completion-for-mentions (set (make-local-variable 'company-backends) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index a06b18d..e6a01f8 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -206,13 +206,12 @@ Use. e.g. \"%c\" for your locale's date and time format." (message "Loading Mastodon account %s on %s..." (mastodon-auth--user-acct) mastodon-instance-url)))) ;;;###autoload -(defun mastodon-toot (&optional user reply-to-id) +(defun mastodon-toot (&optional user reply-to-id reply-json) "Update instance with new toot. Content is captured in a new buffer. - If USER is non-nil, insert after @ symbol to begin new toot. If REPLY-TO-ID is non-nil, attach new toot to a conversation." (interactive) - (mastodon-toot--compose-buffer user reply-to-id)) + (mastodon-toot--compose-buffer user reply-to-id reply-json)) ;;;###autoload (add-hook 'mastodon-mode-hook (lambda () -- cgit v1.2.3 From 74570658d54f1b8afa7eb414516674c5e724ed70 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 15:41:05 +0200 Subject: when toot replied to has a CW, adopt it as default for replying toot --- lisp/mastodon-toot.el | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index fa44645..17ee473 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -92,6 +92,10 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" "A flag whether the toot should be marked with a content warning.") (make-variable-buffer-local 'mastodon-toot--content-warning) +(defvar mastodon-toot--content-warning-from-reply nil + "The content warning of the toot being replied to.") +(make-variable-buffer-local 'mastodon-toot--content-warning) + (defvar mastodon-toot--content-nsfw nil "A flag indicating whether the toot should be marked as NSFW.") (make-variable-buffer-local 'mastodon-toot--content-nsfw) @@ -332,7 +336,7 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (endpoint (mastodon-http--api "statuses")) (spoiler (when (and (not empty-toot-p) mastodon-toot--content-warning) - (read-string "Warning: "))) + (read-string "Warning: " mastodon-toot--content-warning-from-reply))) (args-no-media `(("status" . ,toot) ("in_reply_to_id" . ,mastodon-toot--reply-to-id) ("visibility" . ,mastodon-toot--visibility) @@ -623,13 +627,17 @@ on the status of NSFW, content warning flags, media attachments, etc." (defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id reply-json) "If REPLY-TO-USER is provided, inject their handle into the message. If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." - (let ((reply-visibility (cdr (assoc 'visibility reply-json)))) + (let ((reply-visibility (cdr (assoc 'visibility reply-json))) + (reply-cw (cdr (assoc 'spoiler_text reply-json)))) (when reply-to-user (insert (format "%s " reply-to-user)) (setq mastodon-toot--reply-to-id reply-to-id) (if (not (equal mastodon-toot--visibility reply-visibility)) - (setq mastodon-toot--visibility reply-visibility))))) + (setq mastodon-toot--visibility reply-visibility)) + (when reply-cw + (setq mastodon-toot--content-warning t) + (setq mastodon-toot--content-warning-from-reply reply-cw))))) (defun mastodon-toot--update-status-fields (&rest args) "Update the status fields in the header based on the current state." -- cgit v1.2.3 From 8d36399e239826b5a8cc34ce15306f9f51759a7f Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 16:17:43 +0200 Subject: redraft toots adopt visibility and CW of deleted toot --- lisp/mastodon-toot.el | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 17ee473..6e41fc1 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -92,7 +92,7 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" "A flag whether the toot should be marked with a content warning.") (make-variable-buffer-local 'mastodon-toot--content-warning) -(defvar mastodon-toot--content-warning-from-reply nil +(defvar mastodon-toot--content-warning-from-reply-or-redraft nil "The content warning of the toot being replied to.") (make-variable-buffer-local 'mastodon-toot--content-warning) @@ -277,7 +277,9 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (url (mastodon-http--api (format "statuses/%s" id)))) + (url (mastodon-http--api (format "statuses/%s" id))) + (toot-cw (cdr (assoc 'spoiler_text toot))) + (toot-visibility (cdr (assoc 'visibility toot)))) (if (or (cdr (assoc 'reblog toot)) (not (equal (cdr (assoc 'acct (cdr (assoc 'account toot)))) @@ -294,7 +296,13 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." ;; (media (cdr (assoc 'media_attachments json-response)))) (mastodon-toot--compose-buffer nil nil) (goto-char (point-max)) - (insert content)))))))))) + (insert content) + ;; adopt visibility and CW from deleted toot: + (setq mastodon-toot--visibility toot-visibility) + (when toot-cw + (setq mastodon-toot--content-warning t) + (setq mastodon-toot--content-warning-from-reply-or-redraft toot-cw)) + (mastodon-toot--update-status-fields)))))))))) (defun mastodon-toot--kill () "Kill `mastodon-toot-mode' buffer and window." @@ -336,7 +344,7 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (endpoint (mastodon-http--api "statuses")) (spoiler (when (and (not empty-toot-p) mastodon-toot--content-warning) - (read-string "Warning: " mastodon-toot--content-warning-from-reply))) + (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) @@ -637,7 +645,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (setq mastodon-toot--visibility reply-visibility)) (when reply-cw (setq mastodon-toot--content-warning t) - (setq mastodon-toot--content-warning-from-reply reply-cw))))) + (setq mastodon-toot--content-warning-from-reply-or-redraft reply-cw))))) (defun mastodon-toot--update-status-fields (&rest args) "Update the status fields in the header based on the current state." @@ -675,7 +683,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (list 'invisible (not mastodon-toot--content-warning) 'face 'mastodon-cw-face))))) -(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id reply-json) +(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id &optional reply-json) "Create a new buffer to capture text for a new toot. If REPLY-TO-USER is provided, inject their handle into the message. If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." -- cgit v1.2.3 From 2329c3a7fc7ab4beb8caaeaedfa2b17ea4cf1db2 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 16:40:31 +0200 Subject: revert to forward-whitespace -1 test for company - this is an attempt to only engage company completion when our "word" at point is prefixed with a "@" - for some reason i dont understand, using company-grab-symbol-cons "^@ ..." doesn't work here: typing words with no @ still triggers company --- lisp/mastodon-toot.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6e41fc1..3a8ae92 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -426,9 +426,13 @@ The prefix string is tested against both user handles and display names." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'mastodon-toot--mentions-completion)) - (prefix (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode - ;; @ + thing before point - (concat "@" (company-grab-symbol-cons "^@[0-9A-Za-z-.\\_@]+" 2)))) + (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode + (save-excursion + (forward-whitespace -1) + (forward-whitespace 1) + (looking-at "@"))) + ;; @ + thing before point + (concat "@" (company-grab-symbol)))) (candidates (mastodon-toot--mentions-company-candidates arg)) (annotation (mastodon-toot--mentions-company-annotation arg)))) -- cgit v1.2.3 From 45390f6ad1923814a3ac28fc456fd264a8b8cd1e Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 19:00:14 +0200 Subject: restore hdurer's http--read-file-as-string --- lisp/mastodon-http.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index fbcf855..6df2aab 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -113,6 +113,12 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (url-retrieve-synchronously url) (url-retrieve-synchronously url nil nil mastodon-http--timeout))))) +(defun mastodon-http--read-file-as-string (filename) + "" + (with-temp-buffer + (insert-file-contents filename) + (string-to-unibyte (buffer-string)))) + (defun mastodon-http--get (url) "Make synchronous GET request to URL. -- cgit v1.2.3 From 53a9c944d06c01f1efc39e5c89eb362b2436dcc0 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 19:01:06 +0200 Subject: move attachments lower in toot-docs --- lisp/mastodon-toot.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3a8ae92..9f9abea 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -611,10 +611,8 @@ on the status of NSFW, content warning flags, media attachments, etc." (concat divider "\n" (mastodon-toot--make-mode-docs) "\n" - divider "\n" - " Attachments: " - (propertize "None " 'toot-attachments t) - "\n" + ;; divider "\n" + ;; "\n" divider "\n" " " (propertize "Count" @@ -629,6 +627,9 @@ on the status of NSFW, content warning flags, media attachments, etc." (propertize "NSFW" 'toot-post-nsfw-flag t) "\n" + " Attachments: " + (propertize "None " 'toot-attachments t) + "\n" divider (propertize "\n" 'rear-nonsticky t)) -- cgit v1.2.3 From a3fd610b172ccad89a463709120ddf4aa27469b6 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 19:37:14 +0200 Subject: print toot keybinding docs in two columns --- lisp/mastodon-toot.el | 42 +++++++++++++++++++++++++++++++++++++----- 1 file changed, 37 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9f9abea..5866636 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -586,19 +586,51 @@ e.g. mastodon-toot--send -> Send." "Format a single keybinding, KBIND, for display in documentation." (let ((key (help-key-description (car kbind) nil)) (command (mastodon-toot--format-kbind-command (cdr kbind)))) - (format "\t%s - %s" key command))) + (format " %s - %s" key command))) (defun mastodon-toot--format-kbinds (kbinds) "Format a list of keybindings, KBINDS, for display in documentation." - (mapconcat 'identity (cons "" (mapcar #'mastodon-toot--format-kbind kbinds)) - "\n")) + (mapcar #'mastodon-toot--format-kbind kbinds)) + +(defvar mastodon-toot--kbinds-pairs nil + "Contains a list of paired toot compose buffer keybindings for inserting.") +(make-variable-buffer-local 'mastodon-toot--kbinds-pairs) + +(defun mastodon-toot--formatted-kbinds-pairs (kbinds-list longest) + "Return a list of strings each containing two formatted kbinds. +KBINDS-LIST is the list of formatted bindings to pair. +LONGEST is the length of the longest binding." + (when kbinds-list + (push (concat "\n" + (car kbinds-list) + (make-string (- (1+ longest) (length (car kbinds-list))) + ?\ ) + (cadr kbinds-list)) + mastodon-toot--kbinds-pairs) + (mastodon-toot--formatted-kbinds-pairs (cddr kbinds-list) longest)) + (reverse mastodon-toot--kbinds-pairs)) + +(defun mastodon-toot--formatted-kbinds-longest (kbinds-list) + "Return the length of the longest item in KBINDS-LIST." + (let ((lengths (mapcar (lambda (x) + (length x)) + kbinds-list))) + (car (sort lengths #'>)))) (defun mastodon-toot--make-mode-docs () "Create formatted documentation text for the mastodon-toot-mode." - (let ((kbinds (mastodon-toot--get-mode-kbinds))) + (let* ((kbinds (mastodon-toot--get-mode-kbinds)) + (longest-kbind + (mastodon-toot--formatted-kbinds-longest + (mastodon-toot--format-kbinds kbinds)))) (concat " Compose a new toot here. The following keybindings are available:" - (mastodon-toot--format-kbinds kbinds)))) + ;; (mastodon-toot--format-kbinds kbinds)))) + (mapconcat 'identity + (mastodon-toot--formatted-kbinds-pairs + (mastodon-toot--format-kbinds kbinds) + longest-kbind) + nil)))) (defun mastodon-toot--display-docs-and-status-fields () "Insert propertized text with documentation about `mastodon-toot-mode'. -- cgit v1.2.3 From 56330f7a073c3cb50119debd74338b2c858e1308 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 20:23:12 +0200 Subject: icon displays for message visibility - direct, or private --- lisp/mastodon-tl.el | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 48237d9..904d850 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -389,7 +389,8 @@ favouriting and following to the byline. It also takes a single function. By default it is `mastodon-tl--byline-boosted'" (let ((parsed-time (date-to-time (mastodon-tl--field 'created_at toot))) (faved (equal 't (mastodon-tl--field 'favourited toot))) - (boosted (equal 't (mastodon-tl--field 'reblogged toot)))) + (boosted (equal 't (mastodon-tl--field 'reblogged toot))) + (visibility (mastodon-tl--field 'visibility toot))) (concat ;; (propertize "\n | " 'face 'default) (propertize @@ -400,6 +401,14 @@ By default it is `mastodon-tl--byline-boosted'" (format "(%s) " (propertize "F" 'face 'mastodon-boost-fave-face))) (funcall author-byline toot) + (cond ((equal visibility "direct") + (if (fontp (char-displayable-p #10r128274)) + " 🔒" + " [direct]")) + ((equal visibility "private") + (if (fontp (char-displayable-p #10r9993)) + " ✉" + " [followers]"))) (funcall action-byline toot) " " ;; TODO: Once we have a view for toot (responses etc.) make -- cgit v1.2.3 From 4e4c6358477aa74424638b1df6fdb13a77e6aaa0 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 20:41:44 +0200 Subject: fix cw test for replies and for redrafts: "" not nil. --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5866636..3a53851 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -299,7 +299,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (insert content) ;; adopt visibility and CW from deleted toot: (setq mastodon-toot--visibility toot-visibility) - (when toot-cw + (when (not (equal toot-cw "")) (setq mastodon-toot--content-warning t) (setq mastodon-toot--content-warning-from-reply-or-redraft toot-cw)) (mastodon-toot--update-status-fields)))))))))) @@ -680,7 +680,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (if (not (equal mastodon-toot--visibility reply-visibility)) (setq mastodon-toot--visibility reply-visibility)) - (when reply-cw + (when (not (equal reply-cw "")) (setq mastodon-toot--content-warning t) (setq mastodon-toot--content-warning-from-reply-or-redraft reply-cw))))) -- cgit v1.2.3 From 846d588dc87b5135dc18b1d7cc873acadfd4c5a3 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 20:42:28 +0200 Subject: redrafts adopt reply to id from deleted toot --- lisp/mastodon-toot.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3a53851..d6502f8 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -279,7 +279,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) (url (mastodon-http--api (format "statuses/%s" id))) (toot-cw (cdr (assoc 'spoiler_text toot))) - (toot-visibility (cdr (assoc 'visibility toot)))) + (toot-visibility (cdr (assoc 'visibility toot))) + (reply-id (cdr (assoc 'in_reply_to_id toot)))) (if (or (cdr (assoc 'reblog toot)) (not (equal (cdr (assoc 'acct (cdr (assoc 'account toot)))) @@ -297,7 +298,9 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (mastodon-toot--compose-buffer nil nil) (goto-char (point-max)) (insert content) - ;; adopt visibility and CW from deleted toot: + ;; adopt reply-to-id, visibility and CW from deleted toot: + (when reply-id + (setq mastodon-toot--reply-to-id reply-id)) (setq mastodon-toot--visibility toot-visibility) (when (not (equal toot-cw "")) (setq mastodon-toot--content-warning t) -- cgit v1.2.3 From 39bf919327a03b8e34ff28f08422b2cb6d3eab26 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 21:29:46 +0200 Subject: readme --- README.org | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/README.org b/README.org index dcccccf..030821d 100644 --- a/README.org +++ b/README.org @@ -9,26 +9,32 @@ It adds the following features: | | display pinned toots on profiles | | | display relationship (follows you/followed by you) on profiles | | | display toots/follows/followers counts on profiles | -| | links/tags/mentions in profiles are active links | +| | links/tags/mentions in profile bios are active links | | =R=, =C-c a=, =C-c r= | view/accept/reject follow requests | | =v= | view your favorited toots | | =i= | toggle pinning of toots | | =S-C-P= | jump to your profile | | =U= | update your profile bio note | +| Notifications: | | +| | follow requests now also appear in notifications | +| =a=, =r= | accept/reject follow requests | | Timelines: | | | =C= | copy url of toot at point | | =d= | delete your toot at point, and reload current timeline | -| =D= | delete and redraft toot at point | +| =D= | delete and redraft toot at point, preserving reply/CW/visibility | | =W=, =M=, =B= | (un)follow, (un)mute, (un)block author of toot at point | | | display polls and vote on polls (pretty basic for now) | | | images are links to the full image, can be zoomed/rotated/saved (see image keymap) | | | images scale properly | +| | toot visibility (direct, followers only) icon appears in toot bylines | | Toots: | | | | mention booster in replies by default | +| | autocompletion of mentions, via company-mode (must be installed to work) | | =C-c C-a= | media uploads | +| | media uploads appear in toot compose buffer to preview | | =C-c C-n= | and sensitive media/nsfw flag | | =C-c C-e= | add emoji (if =emojify= installed) | -| | | +| | replies preserve visibility status/CW of original toot | | Search: | | | =S= | search (posts, users, tags) (NB: only posts you have interacted with are searched) | | | | @@ -69,8 +75,8 @@ I might add a few more features if the ones I added turn out to work ok. Possibl - [X] delete and redraft toots - [X] prevent loss of draft toots by the toot-send bug - [X] fix scaling of images -- [ ] display post visibility status in timelines -- [ ] caching of images / avatars +- [X] display post visibility status in timelines +- [X] caching of images / avatars - better display of polls - display number of boosts/faves in toot byline - mention all thread participants in replies -- cgit v1.2.3