From f5cd8832412ffb16def55807fd68b3d85d4be9b5 Mon Sep 17 00:00:00 2001 From: Johnson Denen Date: Mon, 19 Jun 2017 11:28:37 -0400 Subject: Bump version to 0.7.1 --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7d33116..6ec3174 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.0 +;; Version: 0.7.1 ;; Homepage: https://github.com/jdenen/mastodon.el ;; Package-Requires: ((emacs "24.4")) -- cgit v1.2.3 From 5a8ede2990c208b1c4059092f21d216203bd0db5 Mon Sep 17 00:00:00 2001 From: Alexander Griffith Date: Wed, 28 Feb 2018 12:44:33 -0500 Subject: Closes #152 and extends the fix for #150 as well as a host of bug fixes We now kill the http get request buffer once JSON has been extracted. mastodon-tl--as-string was implemented and replaced any occurrence of number-to-string or int-to-string Added variable mastodon-tl--display-media-p. By default it is 't but can be made a local buffer variable and set to nil. When nil rather than displaying the media it just provides a link Media:: Fixed checking for faves and boosts, they should now render properly. The return from json-read-from-string for nil is :json-false which evaluates to 't in elisp. Fixed the format string that gets printed when faving and boosting Fixed mastodon-tl--thread updating and requesting and changed its behaviour such that it tries to open the original toot thread rather than the boosted thread. Added tests for both the new mastodon-tl--as-string function and the mastodon-tl--toot-id utility. enter mastodon mode before defining local buffer variable mastodon-tl--buffer-spec. This fixes some oddities with the local buffer variable. --- lisp/mastodon-http.el | 1 + lisp/mastodon-inspect.el | 2 +- lisp/mastodon-tl.el | 63 ++++++++++++++++++++++++++++++++++------------- lisp/mastodon-toot.el | 14 ++++++----- test/mastodon-tl-tests.el | 22 +++++++++++++++++ 5 files changed, 78 insertions(+), 24 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 75cca2f..f519e20 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -107,6 +107,7 @@ Pass response buffer to CALLBACK function." (decode-coding-string (buffer-substring-no-properties (point) (point-max)) 'utf-8))) + (kill-buffer) (json-read-from-string json-string))))) json-vector)) diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index a44fb2c..c5b2924 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -55,7 +55,7 @@ (interactive) (mastodon-inspect--dump-json-in-buffer (concat "*mastodon-inspect-toot-" - (int-to-string (mastodon-tl--property 'toot-id)) + (mastodon-tl--as-string (mastodon-tl--property 'toot-id)) "*") (mastodon-tl--property 'toot-json))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 38aee76..dbc815f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -62,6 +62,9 @@ keep the timestamps current as time progresses." (image-type-available-p 'imagemagick) "A boolean value stating whether to show avatars in timelines.") +(defvar mastodon-tl--display-media-p t + "A boolean value stating whether to show media in timelines.") + (defvar mastodon-tl--timestamp-next-update nil "The timestamp when the buffer should next be scanned to update the timestamps.") (make-variable-buffer-local 'mastodon-tl--timestamp-next-update) @@ -138,7 +141,7 @@ Optionally start from POS." (name (cdr (assoc 'display_name account))) (avatar-url (cdr (assoc 'avatar account)))) (concat - (when mastodon-tl--show-avatars-p + (when (and mastodon-tl--show-avatars-p mastodon-tl--display-media-p) (mastodon-media--get-avatar-rendering avatar-url)) (propertize name 'face 'mastodon-display-name-face) (propertize (concat " (@" @@ -232,8 +235,8 @@ TIME-STAMP is assumed to be in the past." "Generate byline for TOOT." (let ((id (cdr (assoc 'id toot))) (parsed-time (date-to-time (mastodon-tl--field 'created_at toot))) - (faved (mastodon-tl--field 'favourited toot)) - (boosted (mastodon-tl--field 'reblogged toot))) + (faved (equal 't (mastodon-tl--field 'favourited toot))) + (boosted (equal 't (mastodon-tl--field 'reblogged toot)))) (propertize (concat (propertize "\n | " 'face 'default) (when boosted @@ -289,11 +292,14 @@ also render the html" (lambda (media-attachement) (let ((preview-url (cdr (assoc 'preview_url media-attachement)))) - (mastodon-media--get-media-link-rendering - preview-url))) + (if mastodon-tl--display-media-p + (mastodon-media--get-media-link-rendering + preview-url) + (concat "Media::" preview-url "\n")))) media-attachements ""))) - (if (not (equal media-string "")) - (concat "\n" media-string ) ""))) + (if (not (and (not mastodon-tl--display-media-p) + (equal media-string ""))) + (concat "\n" media-string) ""))) (defun mastodon-tl--content (toot) @@ -324,7 +330,8 @@ also render the html" (goto-char (point-min)) (while (search-forward "\n\n\n | " nil t) (replace-match "\n | ")) - (mastodon-media--inline-images)) + (when mastodon-tl--display-media-p + (mastodon-media--inline-images))) (defun mastodon-tl--get-update-function (&optional buffer) "Get the UPDATE-FUNCTION stored in `mastodon-tl--buffer-spec'" @@ -354,9 +361,7 @@ also render the html" "&" "?") "max_id=" - (if (numberp id ) - (number-to-string id) - id))))) + (mastodon-tl--as-string id))))) (mastodon-http--get-json url))) ;; TODO @@ -369,9 +374,7 @@ also render the html" "&" "?") "since_id=" - (if (numberp id) - (number-to-string id) - id))))) + (mastodon-tl--as-string id))))) (mastodon-http--get-json url))) (defun mastodon-tl--property (prop &optional backward) @@ -395,21 +398,47 @@ Move forward (down) the timeline unless BACKWARD is non-nil." (goto-char (point-max)) (mastodon-tl--property 'toot-id t)) +(defun mastodon-tl--as-string(numeric) + "Convert NUMERIC to string." + (cond ((numberp numeric) + (number-to-string numeric)) + ((stringp numeric) numeric) + (t (error + "Numeric:%s must be either a string or a number" + numeric)))) + +(defun mastodon-tl--toot-id (json) + "Find approproiate toot id in JSON. + +If the toot has been boosted use the id found in the +reblog portion of the toot. Otherwise, use the body of +the toot. This is the same behaviour as the mastodon.social +webapp" + (let ((id (cdr (assoc 'id json))) + (reblog (cdr (assoc 'reblog json)))) + (if reblog (cdr (assoc 'id reblog)) id))) + (defun mastodon-tl--thread () "Open thread buffer for toot under `point'." (interactive) - (let* ((id (number-to-string (mastodon-tl--property 'toot-id))) + (let* ((id (mastodon-tl--as-string (mastodon-tl--toot-id + (mastodon-tl--property 'toot-json)))) (url (mastodon-http--api (format "statuses/%s/context" id))) (buffer (format "*mastodon-thread-%s*" id)) (toot (mastodon-tl--property 'toot-json)) (context (mastodon-http--get-json url))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) + (mastodon-mode) + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,(format "statuses/%s/context" id) + update-function + (lambda(toot) (message "END of thread.")))) (mastodon-tl--timeline (vconcat (cdr (assoc 'ancestors context)) `(,toot) - (cdr (assoc 'descendants context))))) - (mastodon-mode))) + (cdr (assoc 'descendants context))))))) (defun mastodon-tl--more () "Append older toots to timeline." diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6ec3174..7e2451e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -70,7 +70,7 @@ Remove MARKER if RM is non-nil." "Take ACTION on toot at point, then execute CALLBACK." (let* ((id (mastodon-tl--property 'toot-id)) (url (mastodon-http--api (concat "statuses/" - (number-to-string id) + (mastodon-tl--as-string id) "/" action)))) (let ((response (mastodon-http--post url nil nil))) @@ -79,7 +79,8 @@ Remove MARKER if RM is non-nil." (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." (interactive) - (let* ((id (mastodon-tl--property 'toot-id)) + (let* ((id (mastodon-tl--as-string + (mastodon-tl--property 'toot-id))) (boosted (get-text-property (point) 'boosted-p)) (action (if boosted "unreblog" "reblog")) (msg (if boosted "unboosted" "boosted")) @@ -87,19 +88,20 @@ Remove MARKER if RM is non-nil." (mastodon-toot--action action (lambda () (mastodon-toot--action-success "B" remove) - (message (format "%s #%d" msg id)))))) + (message (format "%s #%s" msg id)))))) (defun mastodon-toot--toggle-favourite () "Favourite/unfavourite toot at `point'." (interactive) - (let* ((id (mastodon-tl--property 'toot-id)) + (let* ((id (mastodon-tl--as-string + (mastodon-tl--property 'toot-id))) (faved (get-text-property (point) 'favourited-p)) (action (if faved "unfavourite" "favourite")) (remove (when faved t))) (mastodon-toot--action action (lambda () (mastodon-toot--action-success "F" remove) - (message (format "%sd #%d" action id)))))) + (message (format "%s #%s" action id)))))) (defun mastodon-toot--kill () "Kill `mastodon-toot-mode' buffer and window. @@ -144,7 +146,7 @@ Set `mastodon-toot--content-warning' to nil." "Reply to toot at `point'." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) - (id (number-to-string (mastodon-tl--field 'id toot))) + (id (mastodon-tl--as-string (mastodon-tl--field 'id toot))) (account (mastodon-tl--field 'account toot)) (user (cdr (assoc 'username account)))) (mastodon-toot user id))) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 7d6a08f..5d7699e 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -97,6 +97,28 @@ (let ((input "foobar

")) (should (string= (mastodon-tl--remove-html input) "foobar\n\n")))) +(ert-deftest toot-id-boosted () + "If a toot is boostedm, return the reblog id." + (should (string= (mastodon-tl--as-string + (mastodon-tl--toot-id mastodon-tl-test-base-boosted-toot)) + "4543919"))) + +(ert-deftest toot-id () + "If a toot is boostedm, return the reblog id." + (should (string= (mastodon-tl--as-string + (mastodon-tl--toot-id mastodon-tl-test-base-toot)) + "61208"))) + +(ert-deftest as-string-1 () + "Should accept a string or number and return a string." + (let ((id "1000")) + (should (string= (mastodon-tl--as-string id) id)))) + +(ert-deftest as-string-2 () + "Should accept a string or number and return a string." + (let ((id 1000)) + (should (string= (mastodon-tl--as-string id) (number-to-string id))))) + (ert-deftest more-json () "Should request toots older than max_id." (let ((mastodon-instance-url "https://instance.url")) -- cgit v1.2.3 From b277114d7b3be3447eeecaf3ba7ac0b282a339fe Mon Sep 17 00:00:00 2001 From: Alexander Griffith Date: Mon, 5 Mar 2018 21:39:12 -0500 Subject: Bump to 0.7.2 and shorten long code lines (#172) * Bump version numbers to 0.7.2 * Adjusted functions to bring line length below 90. --- lisp/mastodon-auth.el | 2 +- lisp/mastodon-client.el | 5 ++- lisp/mastodon-http.el | 2 +- lisp/mastodon-inspect.el | 2 +- lisp/mastodon-media.el | 16 +++++--- lisp/mastodon-tl.el | 97 +++++++++++++++++++++++++++++------------------- lisp/mastodon-toot.el | 2 +- lisp/mastodon.el | 2 +- 8 files changed, 78 insertions(+), 50 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index b2399d2..28c14bc 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Homepage: https://github.com/jdenen/mastodon.el ;; Package-Requires: ((emacs "24.4")) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index cceb70a..968cdf3 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Homepage: https://github.com/jdenen/mastodon.el ;; Package-Requires: ((emacs "24.4")) @@ -96,7 +96,8 @@ Make `mastodon-client--fetch' call to determine client values." Read plist from `mastodon-client--token-file' if variable is nil. Fetch and store plist if `mastodon-client--read' returns nil." - (let ((client-details (cdr (assoc mastodon-instance-url mastodon-client--client-details-alist)))) + (let ((client-details + (cdr (assoc mastodon-instance-url mastodon-client--client-details-alist)))) (unless client-details (setq client-details (or (mastodon-client--read) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 905a853..de9d464 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Package-Requires: ((emacs "24.4")) ;; Homepage: https://github.com/jdenen/mastodon.el diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index c5b2924..62a91b5 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Package-Requires: ((emacs "24.4")) ;; Homepage: https://github.com/jdenen/mastodon.el diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index fa5b8c3..2decce4 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Homepage: https://github.com/jdenen/mastodon.el ;; Package-Requires: ((emacs "24.4")) @@ -127,7 +127,8 @@ BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA 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) +(defun mastodon-media--process-image-response + (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'. @@ -151,7 +152,8 @@ REGION-LENGTH is the length of the region that should be replaced with the image (let ((inhibit-read-only t)) (save-restriction (widen) - (put-text-property marker (+ marker region-length) 'media-state 'loaded) + (put-text-property marker + (+ marker region-length) 'media-state 'loaded) (when image ;; We only set the image to display if we could load ;; it; we already have set a default image when we @@ -185,7 +187,10 @@ MEDIA-TYPE is a symbol and either 'avatar or 'media-link." (list marker image-options region-length)) (error (with-current-buffer buffer ;; TODO: Consider adding retries - (put-text-property marker (+ marker region-length) 'media-state 'loading-failed) + (put-text-property marker + (+ marker region-length) + 'media-state + 'loading-failed) :loading-failed)))))) (defun mastodon-media--select-next-media-line () @@ -235,7 +240,8 @@ not been returned." (put-text-property start end 'media-state 'invalid-url) ;; proceed to load this image asynchronously (put-text-property start end 'media-state 'loading) - (mastodon-media--load-image-from-url image-url media-type start (- end start))))))) + (mastodon-media--load-image-from-url + image-url media-type start (- end start))))))) (defun mastodon-media--get-avatar-rendering (avatar-url) "Returns the string to be written that renders the avatar at AVATAR-URL." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index ad5105d..d6f7d04 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Homepage: https://github.com/jdenen/mastodon.el ;; Package-Requires: ((emacs "24.4")) @@ -56,9 +56,12 @@ keep the timestamps current as time progresses." :type '(boolean :tag "Enable relative timestamps and background updater task")) (defcustom mastodon-tl--enable-proportional-fonts nil - "Nonnil to enable using proportional (rather than the default fixed width) fonts when rendering HTML." + "Nonnil to enable using proportional fonts when rendering HTML. + +By default fixed width fonts are used." :group 'mastodon-tl - :type '(boolean :tag "Enable using proportional rather than fixed width fonts when rendering HTML text")) + :type '(boolean :tag "Enable using proportional rather than fixed \ +width fonts when rendering HTML text")) (defvar mastodon-tl--buffer-spec nil "A unique identifier and functions for each Mastodon buffer.") @@ -130,7 +133,8 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (interactive) (let (next-range (search-pos (point))) - (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range 'mastodon-tab-stop search-pos nil)) + (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range + 'mastodon-tab-stop search-pos nil)) (get-text-property (car next-range) 'invisible) (setq search-pos (1+ (cdr next-range)))) ;; do nothing, all the action in in the while condition @@ -149,7 +153,8 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (interactive) (let (next-range (search-pos (point))) - (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range 'mastodon-tab-stop search-pos t)) + (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range + 'mastodon-tab-stop search-pos t)) (get-text-property (car next-range) 'invisible) (setq search-pos (1- (car next-range)))) ;; do nothing, all the action in in the while condition @@ -373,8 +378,8 @@ TIME-STAMP is assumed to be in the past." mastodon-tl--shr-map-replacement mastodon-tl--shr-image-map-replacement))) (add-text-properties start end - (list 'mastodon-tab-stop 'shr-url - 'keymap keymap))))) + (list 'mastodon-tab-stop 'shr-url + 'keymap keymap))))) (buffer-string))) (defun mastodon-tl--set-face (string face) @@ -384,11 +389,14 @@ TIME-STAMP is assumed to be in the past." (defun mastodon-tl--toggle-spoiler-text (position) "Toggle the visibility of the spoiler text at/after POSITION." (let ((inhibit-read-only t) - (spoiler-text-region (mastodon-tl--find-property-range 'mastodon-content-warning-body position nil))) + (spoiler-text-region (mastodon-tl--find-property-range + 'mastodon-content-warning-body position nil))) (if (not spoiler-text-region) (message "No spoiler text here") (add-text-properties (car spoiler-text-region) (cdr spoiler-text-region) - (list 'invisible (not (get-text-property (car spoiler-text-region) 'invisible))))))) + (list 'invisible + (not (get-text-property (car spoiler-text-region) + 'invisible))))))) (defun mastodon-tl--make-link (string link-type) "Return a propertized version of STRING that will act like link. @@ -400,11 +408,11 @@ LINK-TYPE is the type of link to produce." (t (error "unknown link type %s" link-type))))) (propertize - string - 'mastodon-tab-stop link-type - 'mouse-face 'highlight - 'keymap mastodon-tl--link-keymap - 'help-echo help-text))) + string + 'mastodon-tab-stop link-type + 'mouse-face 'highlight + 'keymap mastodon-tl--link-keymap + 'help-echo help-text))) (defun mastodon-tl--do-link-action-at-point (position) (interactive "d") @@ -438,7 +446,9 @@ message is a link which unhides/hides the main body." 'default)) (message (concat "\n" " ---------------\n" - " " (mastodon-tl--make-link "Content Warning" 'content-warning) "\n" + " " (mastodon-tl--make-link "Content Warning" + 'content-warning) + "\n" " ---------------\n")) (cw (mastodon-tl--set-face message 'mastodon-cw-face))) (concat @@ -478,10 +488,11 @@ message is a link which unhides/hides the main body." (insert (concat ;; remove trailing whitespace - (replace-regexp-in-string "[\t\n ]*\\'" "" (if (mastodon-tl--has-spoiler toot) - (mastodon-tl--spoiler toot) - (mastodon-tl--content toot))) - + (replace-regexp-in-string + "[\t\n ]*\\'" "" + (if (mastodon-tl--has-spoiler toot) + (mastodon-tl--spoiler toot) + (mastodon-tl--content toot))) (mastodon-tl--byline toot) "\n\n"))) @@ -616,7 +627,7 @@ webapp" (goto-char point-before))))) (defun mastodon-tl--find-property-range (property start-point &optional search-backwards) -" Returns `nil` if no such range is found. + " Returns `nil` if no such range is found. If PROPERTY is set at START-POINT returns a range around START-POINT otherwise before/after START-POINT. @@ -631,14 +642,17 @@ before (non-nil) or after (nil)" (next-single-property-change start-point property nil (point-max))) (if search-backwards (let* ((end (or (previous-single-property-change - (if (equal start-point (point-max)) start-point (1+ start-point)) + (if (equal start-point (point-max)) + start-point (1+ start-point)) property) - ;; we may either be just before the range or there is nothing at all + ;; we may either be just before the range or there + ;; is nothing at all (and (not (equal start-point (point-min))) (get-text-property (1- start-point) property) start-point))) - (start (and end - (previous-single-property-change end property nil (point-min))))) + (start (and + end + (previous-single-property-change end property nil (point-min))))) (when end (cons start end))) (let* ((start (next-single-property-change start-point property)) @@ -647,7 +661,8 @@ before (non-nil) or after (nil)" (when start (cons start end)))))) -(defun mastodon-tl--find-next-or-previous-property-range (property start-point search-backwards) +(defun mastodon-tl--find-next-or-previous-property-range + (property start-point search-backwards) "Finds (start . end) range after/before START-POINT where PROPERTY is set to a consistent value (different from the value at START-POINT if that is set). Returns nil if no such range exists. @@ -661,9 +676,11 @@ START-POINT otherwise after START-POINT. (let ((current-range (mastodon-tl--find-property-range property start-point))) (if search-backwards (unless (equal (car current-range) (point-min)) - (mastodon-tl--find-property-range property (1- (car current-range)) search-backwards)) + (mastodon-tl--find-property-range + property (1- (car current-range)) search-backwards)) (unless (equal (cdr current-range) (point-max)) - (mastodon-tl--find-property-range property (1+ (cdr current-range)) search-backwards)))) + (mastodon-tl--find-property-range + property (1+ (cdr current-range)) search-backwards)))) ;; If we are not within a range, we can just defer to ;; mastodon-tl--find-property-range directly. (mastodon-tl--find-property-range property start-point search-backwards))) @@ -723,8 +740,9 @@ from the start if it is nil." (seconds-to-time 300)) mastodon-tl--timestamp-update-timer nil)) (while (and (< iteration 5) - (setq next-timestamp-range (mastodon-tl--find-property-range 'timestamp - previous-timestamp))) + (setq next-timestamp-range + (mastodon-tl--find-property-range 'timestamp + previous-timestamp))) (let* ((start (car next-timestamp-range)) (end (cdr next-timestamp-range)) (timestamp (get-text-property start 'timestamp)) @@ -732,15 +750,17 @@ from the start if it is nil." (new-display (mastodon-tl--relative-time-description timestamp))) (unless (string= current-display new-display) (let ((inhibit-read-only t)) - (add-text-properties start end - (list 'display (mastodon-tl--relative-time-description timestamp))))) + (add-text-properties + start end (list 'display + (mastodon-tl--relative-time-description timestamp))))) (mastodon-tl--consider-timestamp-for-updates timestamp) (setq iteration (1+ iteration) previous-timestamp (1+ (cdr next-timestamp-range))))) (if next-timestamp-range ;; schedule the next batch from the previous location to ;; start very soon in the future: - (run-at-time 0.1 nil #'mastodon-tl--update-timestamps-callback buffer (copy-marker previous-timestamp)) + (run-at-time 0.1 nil #'mastodon-tl--update-timestamps-callback buffer + (copy-marker previous-timestamp)) ;; otherwise we are done for now; schedule a new run for when needed (setq mastodon-tl--timestamp-update-timer (run-at-time mastodon-tl--timestamp-next-update @@ -781,12 +801,13 @@ UPDATE-FUNCTION is used to recieve more toots." `(buffer-name ,buffer-name endpoint ,endpoint update-function ,update-function) - mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps - (run-at-time mastodon-tl--timestamp-next-update - nil ;; don't repeat - #'mastodon-tl--update-timestamps-callback - (current-buffer) - nil)))) + mastodon-tl--timestamp-update-timer + (when mastodon-tl--enable-relative-timestamps + (run-at-time mastodon-tl--timestamp-next-update + nil ;; don't repeat + #'mastodon-tl--update-timestamps-callback + (current-buffer) + nil)))) buffer)) (provide 'mastodon-tl) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7e2451e..bad9b3f 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Homepage: https://github.com/jdenen/mastodon.el ;; Package-Requires: ((emacs "24.4")) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index e04babe..7f02295 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Package-Requires: ((emacs "24.4")) ;; Homepage: https://github.com/jdenen/mastodon.el -- cgit v1.2.3 From e9920d64b5283fca6a34b2144a5a35c4c1d02938 Mon Sep 17 00:00:00 2001 From: Alexander Griffith Date: Mon, 5 Mar 2018 21:45:45 -0500 Subject: Retoot add accts closes #155 When responding to toots the full acct for both local and federated accounts are now added to the new toot buffer. Changes - Added a function in mastodon.el to return the current user acct - Added mastodon-toot--process-local, which takes an acct and appends the current server if it is local returns an empty string if the acct matches the current user and does only adds a prefix @ if the acct is federated - mastodon-toot--mentions will return a formatted string of mentions or an empty string - adds tests for mastodon-toot--mentions - adds a missing , in mastodon-http--post - `mastodon-toot--reply` now passes `mastodon-toot` a toot-id rather than the whole json - 'mastodon-toot--reply-to-id is now a local var in a new toot --- lisp/mastodon-auth.el | 18 ++++++++++++++++++ lisp/mastodon-http.el | 2 +- lisp/mastodon-tl.el | 3 ++- lisp/mastodon-toot.el | 34 ++++++++++++++++++++++++++++++---- test/mastodon-toot-tests.el | 39 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 90 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 28c14bc..e9889d9 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -43,6 +43,9 @@ (defvar mastodon-auth--token-alist nil "Alist of User access tokens keyed by instance url.") +(defvar mastodon-auth--acct-alist nil + "Alist of account accts (name@domain) keyed by instance url.") + (defun mastodon-auth--generate-token () "Make POST to generate auth token." (mastodon-http--post @@ -79,5 +82,20 @@ Generate token and set if none known yet." (push (cons mastodon-instance-url token) mastodon-auth--token-alist))) token)) +(defun mastodon-auth--get-account-name () + "Request user credentials and return an account name." + (cdr (assoc + 'acct + (mastodon-http--get-json + (mastodon-http--api + "accounts/verify_credentials"))))) + +(defun mastodon-auth--user-acct () + "Return a mastodon user acct name." + (or (cdr (assoc mastodon-instance-url mastodon-auth--acct-alist)) + (let ((acct (mastodon-auth--get-account-name))) + (push (cons mastodon-instance-url acct) mastodon-auth--acct-alist) + acct))) + (provide 'mastodon-auth) ;;; mastodon-auth.el ends here diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index de9d464..3240eef 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -83,7 +83,7 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (url-request-extra-headers (append (unless unauthenticed-p - `(("Authorization" . (concat "Bearer " (mastodon-auth--access-token))))) + `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))) headers))) (with-temp-buffer (url-retrieve-synchronously url)))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d6f7d04..252cefd 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -135,6 +135,7 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (search-pos (point))) (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range 'mastodon-tab-stop search-pos nil)) + (get-text-property (car next-range) 'invisible) (setq search-pos (1+ (cdr next-range)))) ;; do nothing, all the action in in the while condition @@ -397,7 +398,6 @@ TIME-STAMP is assumed to be in the past." (list 'invisible (not (get-text-property (car spoiler-text-region) 'invisible))))))) - (defun mastodon-tl--make-link (string link-type) "Return a propertized version of STRING that will act like link. @@ -488,6 +488,7 @@ message is a link which unhides/hides the main body." (insert (concat ;; remove trailing whitespace + (replace-regexp-in-string "[\t\n ]*\\'" "" (if (mastodon-tl--has-spoiler toot) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index bad9b3f..5db9d32 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -48,7 +48,6 @@ map) "Keymap for `mastodon-toot'.") - (defun mastodon-toot--action-success (marker &optional rm) "Insert MARKER with 'success face in byline. @@ -142,14 +141,40 @@ Set `mastodon-toot--content-warning' to nil." (mastodon-http--triage response (lambda () (message "Toot toot!")))))) +(defun mastodon-toot--process-local (acct) + "Adds domain to local ACCT and replaces the curent user name with \"\". + +Mastodon requires the full user@domain, even in the case of local accts. +eg. \"user\" -> \"user@local.social \" (when local.social is the domain of the +mastodon-instance-url). +eg. \"yourusername\" -> \"\" +eg. \"feduser@fed.social\" -> \"feduser@fed.social\" " + (cond ((string-match-p "@" acct) (concat "@" acct " ")) ; federated acct + ((string= (mastodon-auth--user-acct) acct) "") ; your acct + (t (concat "@" acct "@" ; local acct + (cadr (split-string mastodon-instance-url "/" t)) " ")))) + +(defun mastodon-toot--mentions (status) + "Extract mentions from STATUS and process them into a string." + (interactive) + (let ((mentions (cdr (assoc 'mentions status)))) + (mapconcat (lambda(x) (mastodon-toot--process-local + (cdr (assoc 'acct x)))) + ;; reverse does not work on vectors in 24.5 + (reverse (append mentions nil)) + ""))) + (defun mastodon-toot--reply () "Reply to toot at `point'." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) (id (mastodon-tl--as-string (mastodon-tl--field 'id toot))) (account (mastodon-tl--field 'account toot)) - (user (cdr (assoc 'username account)))) - (mastodon-toot user id))) + (user (cdr (assoc 'acct account))) + (mentions (mastodon-toot--mentions toot))) + (mastodon-toot (when user (concat (mastodon-toot--process-local user) + mentions)) + id))) (defun mastodon-toot--toggle-warning () "Toggle `mastodon-toot--content-warning'." @@ -211,7 +236,8 @@ e.g. mastodon-toot--send -> Send." "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)) + (insert (format "%s " reply-to-user)) + (make-variable-buffer-local 'mastodon-toot--reply-to-id) (setq mastodon-toot--reply-to-id reply-to-id))) (defun mastodon-toot--compose-buffer (reply-to-user reply-to-id) diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index e9d3b26..3e25536 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -1,5 +1,44 @@ (require 'el-mock) +(defconst mastodon-toot-multi-mention + '((mentions . + [((id . "1") + (username . "federated") + (url . "https://site.cafe/@federated") + (acct . "federated@federated.cafe")) + ((id . "1") + (username . "federated") + (url . "https://site.cafe/@federated") + (acct . "federated@federated.social")) + ((id . "1") + (username . "local") + (url . "") + (acct . "local"))]))) + +(defconst mastodon-toot-no-mention + '((mentions . []))) + +(ert-deftest toot-multi-mentions () + (let ((mastodon-auth--acct-alist '(("https://local.social". "null"))) + (mastodon-instance-url "https://local.social")) + (should (string= + (mastodon-toot--mentions mastodon-toot-multi-mention) + "@local@local.social @federated@federated.social @federated@federated.cafe ")))) + +(ert-deftest toot-multi-mentions-with-name () + (let ((mastodon-auth--acct-alist + '(("https://local.social". "local"))) + (mastodon-instance-url "https://local.social")) + (should (string= + (mastodon-toot--mentions mastodon-toot-multi-mention) + "@federated@federated.social @federated@federated.cafe ")))) + +(ert-deftest toot-no-mention () + (let ((mastodon-auth--acct-alist + '(("https://local.social". "null"))) + (mastodon-instance-url "https://local.social")) + (should (string= (mastodon-toot--mentions mastodon-toot-no-mention) "")))) + (ert-deftest cancel () (with-mock (mock (kill-buffer-and-window)) -- cgit v1.2.3