diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-toot.el | 202 |
1 files changed, 99 insertions, 103 deletions
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 1269516..75b0f28 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -268,6 +268,12 @@ data about the item boosted or favourited." (or (mastodon-tl--property 'base-toot :no-move) ; fave/boost notifs (mastodon-tl--property 'item-json))) +(defun mastodon-toot--inc-or-dec (count subtract) + "If SUBTRACT, decrement COUNT, else increment." + (if subtract + (1- count) + (1+ count))) + ;;; MACRO @@ -349,12 +355,12 @@ JSON is added to the string as its item-json." (let ((inhibit-read-only t) (bol (car byline-region)) (eol (cdr byline-region)) - (at-byline-p (eq (mastodon-tl--property 'byline :no-move) t))) + (at-byline-p (eq t (mastodon-tl--property 'byline :no-move)))) (save-excursion (when remove (goto-char bol) (beginning-of-line) ;; The marker is not part of the byline - (if (search-forward (format "(%s) " marker) eol t) + (if (search-forward (format "(%s) " marker) eol :no-error) (replace-match "") (user-error "Oops: could not find marker '(%s)'" marker))) (unless remove @@ -415,9 +421,10 @@ ACTION is a symbol, either `favourite' or `boost.'" (get-text-property (car byline-region) 'favourited-p))) (str-api (if boost-p "reblog" action-str)) (action-str-api (mastodon-toot--str-negify str-api faved boosted)) - (action-pp (concat (mastodon-toot--str-negify action-str faved boosted) - (if boost-p "ed" "d"))) - (remove (if boost-p (when boosted t) (when faved t)))) + (action-pp (concat + (mastodon-toot--str-negify action-str faved boosted) + (if boost-p "ed" "d"))) + (remove-p (if boost-p boosted faved))) (mastodon-toot--action action-str-api (lambda (_) @@ -427,9 +434,9 @@ ACTION is a symbol, either `favourite' or `boost.'" (if boost-p (list 'boosted-p (not boosted)) (list 'favourited-p (not faved)))) - (mastodon-toot--update-stats-on-action action remove) + (mastodon-toot--update-stats-on-action action remove-p) (mastodon-toot--action-success (mastodon-tl--symbol action) - byline-region remove item-json)) + byline-region remove-p item-json)) (message "%s #%s" action-pp id))))))))) (defun mastodon-toot--str-negify (str faved boosted) @@ -438,33 +445,29 @@ ACTION is a symbol, either `favourite' or `boost.'" (concat "un" str) str)) -(defun mastodon-toot--inc-or-dec (count subtract) - "If SUBTRACT, decrement COUNT, else increment." - (if subtract - (1- count) - (1+ count))) - (defun mastodon-toot--update-stats-on-action (action &optional subtract) "Increment the toot stats display upon ACTION. ACTION is a symbol, either `favourite' or `boost'. SUBTRACT means we are un-favouriting or unboosting, so we decrement." - (let* ((count-prop (if (eq action 'favourite) - 'favourites-count - 'boosts-count)) - (count-prop-range (mastodon-tl--find-property-range count-prop (point))) - (count (get-text-property (car count-prop-range) count-prop)) - (inhibit-read-only 1)) - ;; TODO another way to implement this would be to async fetch counts again - ;; and re-display from count-properties - (add-text-properties (car count-prop-range) - (cdr count-prop-range) - (list 'display - (number-to-string - (mastodon-toot--inc-or-dec count subtract)) - ;; update the count prop - ;; we rely on this for any subsequent actions: - count-prop - (mastodon-toot--inc-or-dec count subtract))))) + (if (not (symbolp action)) + (error "Invalid argument: symbolp %s" action) + (let* ((count-prop (if (eq action 'favourite) + 'favourites-count + 'boosts-count)) + (count-range (mastodon-tl--find-property-range count-prop (point))) + (count (get-text-property (car count-range) count-prop)) + (inhibit-read-only 1)) + ;; TODO another way to implement this would be to async fetch counts again + ;; and re-display from count-properties + (add-text-properties (car count-range) + (cdr count-range) + (list 'display + (number-to-string + (mastodon-toot--inc-or-dec count subtract)) + ;; update the count prop + ;; we rely on this for any subsequent actions: + count-prop + (mastodon-toot--inc-or-dec count subtract)))))) (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." @@ -508,17 +511,17 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." byline-region bookmarked-p item-json) (message "%s #%s" message id)))))))))) -(defun mastodon-toot--list-toot-boosters () +(defun mastodon-toot--list-boosters () "List the boosters of toot at point." (interactive) - (mastodon-toot--list-toot-boosters-or-favers)) + (mastodon-toot--list-boosters-or-favers)) -(defun mastodon-toot--list-toot-favouriters () +(defun mastodon-toot--list-favouriters () "List the favouriters of toot at point." (interactive) - (mastodon-toot--list-toot-boosters-or-favers :favourite)) + (mastodon-toot--list-boosters-or-favers :favourite)) -(defun mastodon-toot--list-toot-boosters-or-favers (&optional favourite) +(defun mastodon-toot--list-boosters-or-favers (&optional favourite) "List the favouriters or boosters of toot at point. With FAVOURITE, list favouriters, else list boosters." (mastodon-toot--with-toot-item @@ -598,13 +601,12 @@ Uses `lingva.el'." (interactive) (let* ((toot (mastodon-toot--base-toot-or-item-json)) (pinnable-p (mastodon-toot--own-toot-p toot)) - (pinned-p (equal (alist-get 'pinned toot) t)) + (pinned-p (eq t (alist-get 'pinned toot))) (action (if pinned-p "unpin" "pin")) - (msg (if pinned-p "unpinned" "pinned")) - (msg-y-or-n (if pinned-p "Unpin" "Pin"))) + (msg (if pinned-p "unpinned" "pinned"))) (if (not pinnable-p) (user-error "You can only pin your own toots") - (when (y-or-n-p (format "%s this toot? " msg-y-or-n)) + (when (y-or-n-p (format "%s this toot? " (capitalize action))) (mastodon-toot--action action (lambda (_) (when mastodon-tl--buffer-spec @@ -627,28 +629,26 @@ NO-REDRAFT means delete toot only." (let* ((toot (mastodon-toot--base-toot-or-item-json)) (id (mastodon-tl--as-string (mastodon-tl--item-id toot))) (url (mastodon-http--api (format "statuses/%s" id))) - (toot-cw (alist-get 'spoiler_text toot)) - (toot-visibility (alist-get 'visibility toot)) - (reply-id (alist-get 'in_reply_to_id toot)) (pos (point))) - (if (not (mastodon-toot--own-toot-p toot)) - (user-error "You can only delete (and redraft) your own toots") - (when (y-or-n-p (if no-redraft - (format "Delete this toot? ") - (format "Delete and redraft this toot? "))) - (let* ((response (mastodon-http--delete url))) - (mastodon-http--triage - response - (lambda (_) - (if no-redraft - (progn - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile pos)) - (message "Toot deleted!")) - (mastodon-toot--redraft response - reply-id - toot-visibility - toot-cw))))))))) + (let-alist toot + (if (not (mastodon-toot--own-toot-p toot)) + (user-error "You can only delete (and redraft) your own toots") + (when (y-or-n-p (if no-redraft + (format "Delete this toot? ") + (format "Delete and redraft this toot? "))) + (let* ((response (mastodon-http--delete url))) + (mastodon-http--triage + response + (lambda (_) + (if no-redraft + (progn + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile pos)) + (message "Toot deleted!")) + (mastodon-toot--redraft response + .in_reply_to_id + .visibility + .spoiler_text)))))))))) (defun mastodon-toot--set-cw (&optional cw) "Set content warning to CW if it is non-nil." @@ -659,12 +659,13 @@ NO-REDRAFT means delete toot only." ;;; REDRAFT -(defun mastodon-toot--redraft (response &optional reply-id toot-visibility toot-cw) +(defun mastodon-toot--redraft (response &optional reply-id toot-visibility + toot-cw) "Opens a new toot compose buffer using values from RESPONSE buffer. REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." (with-current-buffer response - (let* ((json-response (mastodon-http--process-json)) - (content (alist-get 'text json-response))) + (let* ((response (mastodon-http--process-json)) + (content (alist-get 'text response))) (mastodon-toot--compose-buffer) (goto-char (point-max)) (insert content) @@ -726,11 +727,10 @@ CANCEL means the toot was not sent, so we save the toot text as a draft." "Kill new-toot buffer/window. Does not POST content. If toot is not empty, prompt to save text as a draft." (interactive) - (if (mastodon-toot--empty-p) - (mastodon-toot--kill) - (when (y-or-n-p "Save draft toot?") - (mastodon-toot--save-draft)) - (mastodon-toot--kill))) + (when (and (not (mastodon-toot--empty-p)) + (y-or-n-p "Save draft toot?")) + (mastodon-toot--save-draft)) + (mastodon-toot--kill)) (defun mastodon-toot--save-draft () "Save the current compose toot text as a draft. @@ -872,9 +872,9 @@ instance to edit a toot." (scheduled mastodon-toot--scheduled-for) (scheduled-id mastodon-toot--scheduled-id) (edit-id mastodon-toot--edit-item-id) - (endpoint (if edit-id ; we are sending an edit: - (mastodon-http--api (format "statuses/%s" edit-id)) - (mastodon-http--api "statuses"))) + (endpoint (mastodon-http--api (if edit-id ; we are sending an edit: + (format "statuses/%s" edit-id) + "statuses"))) (args-no-media (append `(("status" . ,toot) ("in_reply_to_id" . ,mastodon-toot--reply-to-id) ("visibility" . ,mastodon-toot--visibility) @@ -912,9 +912,10 @@ instance to edit a toot." ((mastodon-toot--empty-p) (user-error "Empty toot. Cowardly refusing to post this")) (t - (let ((response (if edit-id ; we are sending an edit: - (mastodon-http--put endpoint args) - (mastodon-http--post endpoint args)))) + (let ((response (funcall (if edit-id ; we are sending an edit: + #'mastodon-http--put + #'mastodon-http--post) + endpoint args))) (mastodon-http--triage response (lambda (_) @@ -927,13 +928,10 @@ instance to edit a toot." scheduled-id :no-confirm)) ;; window config: (mastodon-toot--restore-previous-window-config prev-window-config) - ;; reload previous view in certain cases: - ;; we reload: - when we have been editing - ;; - when we are in thread view - ;; - ? - ;; (we don't necessarily want to reload in every posting case - ;; as it can sometimes be slow and we may still lose our place - ;; in a timeline.) + ;; reload: - when we have been editing + ;; - when we are in thread view + ;; (we don't reload in every case as it can be slow and we may + ;; lose our place in a timeline.) (when (or edit-id (equal 'thread (mastodon-tl--get-buffer-type))) (let ((pos (marker-position (cadr prev-window-config)))) @@ -1003,7 +1001,6 @@ instance to edit a toot." (defun mastodon-toot--insert-toot-iter (it) "Insert iteration IT of toot." (let ((content (alist-get 'content it))) - ;; (account (alist-get 'account it)) ;; TODO: handle polls, media (mastodon-tl--render-text content))) @@ -1029,8 +1026,10 @@ 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)))))) + (t + (concat "@" acct "@" ; local acct + (cadr + (split-string mastodon-instance-url "/" :omit-nulls)))))) ;;; COMPLETION (TAGS, MENTIONS) @@ -1066,19 +1065,19 @@ Federated user: `username@host.co`." The candidates are calculated according to currently active `emojify-emoji-styles'. Hacked off `emojify--get-completing-read-candidates'." - (let ((styles ;'("ascii" "unicode" "github") - (mapcar #'symbol-name emojify-emoji-styles))) + (let ((styles (mapcar #'symbol-name emojify-emoji-styles))) (let ((emojis '())) - (emojify-emojis-each (lambda (key value) - (when (seq-position styles (ht-get value "style")) - (push (cons key - (format "%s (%s)" - (ht-get value "name") - (ht-get value "style"))) - emojis)))) + (emojify-emojis-each + (lambda (key value) + (when (seq-position styles (ht-get value "style")) + (push (cons key + (format "%s (%s)" + (ht-get value "name") + (ht-get value "style"))) + emojis)))) emojis))) -(defun mastodon-toot--fetch-completion-candidates (start end &optional type) +(defun mastodon-toot--fetch-candidates (start end &optional type) "Search for a completion prefix from buffer positions START to END. Return a list of candidates. TYPE is the candidate type, it may be :tags, :handles, or :emoji." @@ -1101,7 +1100,7 @@ TYPE is the candidate type, it may be :tags, :handles, or :emoji." (defun mastodon-toot--make-capf (regex annot-fun type) "Build a completion backend for `completion-at-point-functions'. REGEX is the regex to match preceding text. -TYPE is a keyword symbol for `mastodon-toot--fetch-completion-candidates'. +TYPE is a keyword symbol for `mastodon-toot--fetch-candidates'. ANNOT-FUN is a function returning an annotatation from a single arg, a candidate." (let* ((bounds (mastodon-toot--get-bounds regex)) @@ -1115,7 +1114,7 @@ arg, a candidate." ;; Interruptible candidate computation, from minad/d mendler, thanks! (let ((result (while-no-input - (mastodon-toot--fetch-completion-candidates + (mastodon-toot--fetch-candidates start end type)))) (and (consp result) result)))) :exclusive 'no @@ -1458,9 +1457,7 @@ Sets `mastodon-toot-poll' to nil." expiry-seconds-from-now)) (expiry-human (car (mastodon-tl--human-duration expiry-seconds-from-now))) (options (mastodon-tl--map-alist 'title .options)) - (multiple (if (eq :json-false .multiple) - nil - t))) + (multiple (if (eq :json-false .multiple) nil t))) (setq mastodon-toot-poll `( :options ,options :expiry-readable ,expiry-human :expiry ,expiry-str :multi ,multiple))))) @@ -1677,7 +1674,8 @@ The default is given by `mastodon-toot--default-reply-visibility'." (let ((less-restrictive (member (intern mastodon-toot--default-reply-visibility) mastodon-toot-visibility-list))) (if (member (intern reply-visibility) less-restrictive) - mastodon-toot--default-reply-visibility reply-visibility)))) + mastodon-toot--default-reply-visibility + reply-visibility)))) (defun mastodon-toot--fill-buffer () "Mark buffer, call `fill-region'." @@ -1688,7 +1686,6 @@ The default is given by `mastodon-toot--default-reply-visibility'." (defun mastodon-toot--render-reply-region-str (str) "Refill STR and prefix all lines with >, as reply-quote text." (with-temp-buffer - ;; (switch-to-buffer (current-buffer)) (insert str) ;; unfill first: (let ((fill-column (point-max))) @@ -1699,8 +1696,7 @@ The default is given by `mastodon-toot--default-reply-visibility'." (save-match-data (while (re-search-forward "^" nil t) (replace-match " > "))) - (buffer-substring-no-properties (point-min) - (point-max)))) + (buffer-substring-no-properties (point-min) (point-max)))) (defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id reply-json reply-region) |