aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisp/mastodon-iso.el1
-rw-r--r--lisp/mastodon-profile.el200
-rw-r--r--lisp/mastodon-search.el86
-rw-r--r--lisp/mastodon-tl.el438
-rw-r--r--lisp/mastodon-toot.el264
-rw-r--r--lisp/mastodon-views.el48
-rw-r--r--lisp/mastodon.el21
-rw-r--r--test/ert-helper.el2
8 files changed, 567 insertions, 493 deletions
diff --git a/lisp/mastodon-iso.el b/lisp/mastodon-iso.el
index 341593c..909d3dd 100644
--- a/lisp/mastodon-iso.el
+++ b/lisp/mastodon-iso.el
@@ -3,7 +3,6 @@
;; Copyright (C) 2022 Marty Hiatt
;; Author: Marty Hiatt <martianhiatus@riseup.net>
;; Version: 1.0.0
-;; Package-Requires: ((emacs "27.1") (request "0.3.0"))
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 7fb36ad..241fbbe 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -6,7 +6,6 @@
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
;; Version: 1.0.0
-;; Package-Requires: ((emacs "27.1"))
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -39,6 +38,8 @@
(require 'cl-lib)
(require 'persist)
(require 'parse-time)
+(eval-when-compile
+ (require 'mastodon-tl))
(autoload 'mastodon-auth--get-account-id "mastodon-auth")
(autoload 'mastodon-auth--get-account-name "mastodon-auth.el")
@@ -78,6 +79,7 @@
(autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot")
(autoload 'mastodon-views--add-account-to-list "mastodon-views")
+(defvar mastodon-tl--horiz-bar)
(defvar mastodon-tl--update-point)
(defvar mastodon-toot--max-toot-chars)
(defvar mastodon-toot--visibility)
@@ -493,21 +495,15 @@ This endpoint only holds a few preferences. For others, see
(let* ((url (mastodon-http--api "preferences"))
(response (mastodon-http--get-json url))
(buf (get-buffer-create "*mastodon-preferences*")))
- (with-current-buffer buf
- (switch-to-buffer-other-window buf)
- (erase-buffer)
- (special-mode)
- (mastodon-tl--set-buffer-spec (buffer-name buf)
- "preferences"
- nil)
- (let ((inhibit-read-only t))
- (while response
- (let ((el (pop response)))
- (insert
- (format "%-30s %s"
- (prin1-to-string (car el))
- (prin1-to-string (cdr el)))
- "\n\n"))))
+ (with-mastodon-buffer buf #'special-mode :other-window
+ (mastodon-tl--set-buffer-spec (buffer-name buf) "preferences" nil)
+ (while response
+ (let ((el (pop response)))
+ (insert
+ (format "%-30s %s"
+ (prin1-to-string (car el))
+ (prin1-to-string (cdr el)))
+ "\n\n")))
(goto-char (point-min)))))
;; PROFILE VIEW DETAILS
@@ -605,95 +601,91 @@ HEADERS means also fetch link headers for pagination."
(fields (mastodon-profile--fields-get account))
(pinned (mastodon-profile--get-statuses-pinned account))
(joined (mastodon-profile--account-field account 'created_at)))
- (with-current-buffer (get-buffer-create buffer)
- (let ((inhibit-read-only t))
- (switch-to-buffer buffer)
- (erase-buffer)
- (mastodon-mode)
- (mastodon-profile-mode)
- (setq mastodon-profile--account account)
- (mastodon-tl--set-buffer-spec buffer
- endpoint
- update-function
- link-header)
- (let* ((inhibit-read-only t)
- (is-statuses (string= endpoint-type "statuses"))
- (is-followers (string= endpoint-type "followers"))
- (is-following (string= endpoint-type "following"))
- (endpoint-name (cond
- (is-statuses (if no-reblogs
- " TOOTS (no boosts)"
- " TOOTS "))
- (is-followers " FOLLOWERS ")
- (is-following " FOLLOWING "))))
- (insert
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (mastodon-profile-mode)
+ (setq mastodon-profile--account account)
+ (mastodon-tl--set-buffer-spec buffer
+ endpoint
+ update-function
+ link-header)
+ (let* ((inhibit-read-only t)
+ (is-statuses (string= endpoint-type "statuses"))
+ (is-followers (string= endpoint-type "followers"))
+ (is-following (string= endpoint-type "following"))
+ (endpoint-name (cond
+ (is-statuses (if no-reblogs
+ " TOOTS (no boosts)"
+ " TOOTS "))
+ (is-followers " FOLLOWERS ")
+ (is-following " FOLLOWING "))))
+ (insert
+ (propertize
+ (concat
+ "\n"
+ (mastodon-profile--image-from-account account 'avatar_static)
+ (mastodon-profile--image-from-account account 'header_static)
+ "\n"
+ (propertize (mastodon-profile--account-field
+ account 'display_name)
+ 'face 'mastodon-display-name-face)
+ "\n"
+ (propertize (concat "@" acct)
+ 'face 'default)
+ (if (equal locked t)
+ (concat " " (mastodon-tl--symbol 'locked))
+ "")
+ "\n " mastodon-tl--horiz-bar "\n"
+ ;; profile note:
+ ;; account here to enable tab-stops in profile note
+ (mastodon-tl--render-text note account)
+ ;; meta fields:
+ (if fields
+ (concat "\n"
+ (mastodon-tl--set-face
+ (mastodon-profile--fields-insert fields)
+ 'success))
+ "")
+ "\n"
+ ;; Joined date:
(propertize
- (concat
- "\n"
- (mastodon-profile--image-from-account account 'avatar_static)
- (mastodon-profile--image-from-account account 'header_static)
- "\n"
- (propertize (mastodon-profile--account-field
- account 'display_name)
- 'face 'mastodon-display-name-face)
- "\n"
- (propertize (concat "@" acct)
- 'face 'default)
- (if (equal locked t)
- (concat " " (mastodon-tl--symbol 'locked))
- "")
- "\n " mastodon-tl--horiz-bar "\n"
- ;; profile note:
- ;; account here to enable tab-stops in profile note
- (mastodon-tl--render-text note account)
- ;; meta fields:
- (if fields
- (concat "\n"
- (mastodon-tl--set-face
- (mastodon-profile--fields-insert fields)
- 'success))
- "")
- "\n"
- ;; Joined date:
- (propertize
- (mastodon-profile--format-joined-date-string joined)
- 'face 'success)
- "\n\n")
- 'profile-json account)
- ;; insert counts
- (mastodon-tl--set-face
- (concat " " mastodon-tl--horiz-bar "\n"
- " TOOTS: " toots-count " | "
- "FOLLOWERS: " followers-count " | "
- "FOLLOWING: " following-count "\n"
- " " mastodon-tl--horiz-bar "\n\n")
- 'success)
- ;; insert relationship (follows)
- (if followsp
- (mastodon-tl--set-face
- (concat (when (equal follows-you 't)
- " | FOLLOWS YOU")
- (when (equal followed-by-you 't)
- " | FOLLOWED BY YOU")
- (when (equal requested-you 't)
- " | REQUESTED TO FOLLOW YOU")
- "\n\n")
- 'success)
- "") ; if no followsp we still need str-or-char-p for insert
- ;; insert endpoint
- (mastodon-tl--set-face
- (concat " " mastodon-tl--horiz-bar "\n"
- endpoint-name "\n"
- " " mastodon-tl--horiz-bar "\n")
- 'success))
- (setq mastodon-tl--update-point (point))
- (mastodon-media--inline-images (point-min) (point))
- ;; insert pinned toots first
- (when (and pinned (equal endpoint-type "statuses"))
- (mastodon-profile--insert-statuses-pinned pinned)
- (setq mastodon-tl--update-point (point))) ;updates to follow pinned toots
- (funcall update-function json)))
- (goto-char (point-min)))))
+ (mastodon-profile--format-joined-date-string joined)
+ 'face 'success)
+ "\n\n")
+ 'profile-json account)
+ ;; insert counts
+ (mastodon-tl--set-face
+ (concat " " mastodon-tl--horiz-bar "\n"
+ " TOOTS: " toots-count " | "
+ "FOLLOWERS: " followers-count " | "
+ "FOLLOWING: " following-count "\n"
+ " " mastodon-tl--horiz-bar "\n\n")
+ 'success)
+ ;; insert relationship (follows)
+ (if followsp
+ (mastodon-tl--set-face
+ (concat (when (equal follows-you 't)
+ " | FOLLOWS YOU")
+ (when (equal followed-by-you 't)
+ " | FOLLOWED BY YOU")
+ (when (equal requested-you 't)
+ " | REQUESTED TO FOLLOW YOU")
+ "\n\n")
+ 'success)
+ "") ; if no followsp we still need str-or-char-p for insert
+ ;; insert endpoint
+ (mastodon-tl--set-face
+ (concat " " mastodon-tl--horiz-bar "\n"
+ endpoint-name "\n"
+ " " mastodon-tl--horiz-bar "\n")
+ 'success))
+ (setq mastodon-tl--update-point (point))
+ (mastodon-media--inline-images (point-min) (point))
+ ;; insert pinned toots first
+ (when (and pinned (equal endpoint-type "statuses"))
+ (mastodon-profile--insert-statuses-pinned pinned)
+ (setq mastodon-tl--update-point (point))) ;updates to follow pinned toots
+ (funcall update-function json)))
+ (goto-char (point-min))))
(defun mastodon-profile--format-joined-date-string (joined)
"Format a human-readable Joined string from timestamp JOINED.
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index 8cfa3cb..4b5f2e0 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -29,6 +29,8 @@
;;; Code:
(require 'json)
+(eval-when-compile
+ (require 'mastodon-tl))
(autoload 'mastodon-auth--access-token "mastodon-auth")
(autoload 'mastodon-http--api "mastodon-http")
@@ -118,22 +120,18 @@ PRINT-FUN is the function used to print the data from the response."
(message "todo"))))
(buffer (get-buffer-create
(format "*mastodon-trending-%s*" type))))
- (with-current-buffer buffer
- (switch-to-buffer (current-buffer))
- (mastodon-mode)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (mastodon-tl--set-buffer-spec (buffer-name buffer)
- (format "api/v1/trends/%s" type)
- nil)
- (insert (mastodon-tl--set-face
- (concat "\n " mastodon-tl--horiz-bar "\n"
- (upcase (format " TRENDING %s\n" type))
- " " mastodon-tl--horiz-bar "\n\n")
- 'success))
- (funcall print-fun data)
- (unless (equal type "statuses")
- (goto-char (point-min)))))))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (mastodon-tl--set-buffer-spec (buffer-name buffer)
+ (format "api/v1/trends/%s" type)
+ nil)
+ (insert (mastodon-tl--set-face
+ (concat "\n " mastodon-tl--horiz-bar "\n"
+ (upcase (format " TRENDING %s\n" type))
+ " " mastodon-tl--horiz-bar "\n\n")
+ 'success))
+ (funcall print-fun data)
+ (unless (equal type "statuses")
+ (goto-char (point-min))))))
;; functions for mastodon search
@@ -153,36 +151,32 @@ PRINT-FUN is the function used to print the data from the response."
tags))
(toots-list-json
(mastodon-search--get-full-statuses-data statuses)))
- (with-current-buffer (get-buffer-create buffer)
- (switch-to-buffer buffer)
- (mastodon-mode)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (mastodon-tl--set-buffer-spec buffer
- "api/v2/search"
- nil)
- ;; user results:
- (insert (mastodon-tl--set-face
- (concat "\n " mastodon-tl--horiz-bar "\n"
- " USERS\n"
- " " mastodon-tl--horiz-bar "\n\n")
- 'success))
- (mastodon-search--insert-users-propertized accts :note)
- ;; hashtag results:
- (insert (mastodon-tl--set-face
- (concat "\n " mastodon-tl--horiz-bar "\n"
- " HASHTAGS\n"
- " " mastodon-tl--horiz-bar "\n\n")
- 'success))
- (mastodon-search--print-tags-list tags-list)
- ;; status results:
- (insert (mastodon-tl--set-face
- (concat "\n " mastodon-tl--horiz-bar "\n"
- " STATUSES\n"
- " " mastodon-tl--horiz-bar "\n")
- 'success))
- (mapc #'mastodon-tl--toot toots-list-json)
- (goto-char (point-min))))))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (mastodon-tl--set-buffer-spec buffer
+ "api/v2/search"
+ nil)
+ ;; user results:
+ (insert (mastodon-tl--set-face
+ (concat "\n " mastodon-tl--horiz-bar "\n"
+ " USERS\n"
+ " " mastodon-tl--horiz-bar "\n\n")
+ 'success))
+ (mastodon-search--insert-users-propertized accts :note)
+ ;; hashtag results:
+ (insert (mastodon-tl--set-face
+ (concat "\n " mastodon-tl--horiz-bar "\n"
+ " HASHTAGS\n"
+ " " mastodon-tl--horiz-bar "\n\n")
+ 'success))
+ (mastodon-search--print-tags-list tags-list)
+ ;; status results:
+ (insert (mastodon-tl--set-face
+ (concat "\n " mastodon-tl--horiz-bar "\n"
+ " STATUSES\n"
+ " " mastodon-tl--horiz-bar "\n")
+ 'success))
+ (mapc #'mastodon-tl--toot toots-list-json)
+ (goto-char (point-min)))))
(defun mastodon-search--insert-users-propertized (json &optional note)
"Insert users list into the buffer.
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index b2b7d27..f9db25a 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -140,7 +140,9 @@ nil."
(locked . ("🔒" . "[locked]"))
(private . ("🔒" . "[followers]"))
(direct . ("✉" . "[direct]"))
- (edited . ("✍" . "[edited]")))
+ (edited . ("✍" . "[edited]"))
+ (replied . ("⬇" . "↓"))
+ (reply-bar . ("┃" . "|")))
"A set of symbols (and fallback strings) to be used in timeline.
If a symbol does not look right (tofu), it means your
font settings do not support it."
@@ -193,6 +195,7 @@ If nil `(point-min)' is used instead.")
(if (char-displayable-p ?―)
(make-string 12 ?―)
(make-string 12 ?-)))
+
;;; KEYMAPS
@@ -255,9 +258,28 @@ types of mastodon links and not just shr.el-generated ones.")
It is active where point is placed by `mastodon-tl--goto-next-toot.'")
+;;; BUFFER MACRO
+
+(defmacro with-mastodon-buffer (buffer mode-fun other-window &rest body)
+ "Evaluate BODY in a new or existing buffer called BUFFER.
+MODE-FUN is called to set the major mode.
+OTHER-WINDOW means call `switch-to-buffer-other-window' rather
+than `switch-to-buffer'."
+ (declare (debug t)
+ (indent 3))
+ `(with-current-buffer (get-buffer-create ,buffer)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (funcall ,mode-fun)
+ (if ,other-window
+ (switch-to-buffer-other-window ,buffer)
+ (switch-to-buffer ,buffer))
+ ,@body)))
+
+
;;; NAV
-(defun mastodon-tl--next-tab-item ()
+(defun mastodon-tl--next-tab-item (&optional previous)
"Move to the next interesting item.
This could be the next toot, link, or image; whichever comes first.
Don't move if nothing else to move to is found, i.e. near the end of the buffer.
@@ -265,11 +287,14 @@ 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 previous))
(get-text-property (car next-range) 'invisible)
- (setq search-pos (1+ (cdr next-range))))
- ;; do nothing, all the action in in the while condition
+ (setq search-pos (if previous
+ (1- (car next-range))
+ (1+ (cdr next-range)))))
+ ;; do nothing, all the action is in the while condition
)
(if (null next-range)
(message "Nothing else here.")
@@ -283,18 +308,7 @@ first. Don't move if nothing else to move to is found, i.e. near
the start of the buffer. 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))
- (get-text-property (car next-range) 'invisible)
- (setq search-pos (1- (car next-range))))
- ;; do nothing, all the action in in the while condition
- )
- (if (null next-range)
- (message "Nothing else before this.")
- (goto-char (car next-range))
- (message "%s" (mastodon-tl--property 'help-echo :no-move)))))
+ (mastodon-tl--next-tab-item :previous))
(defun mastodon-tl--goto-toot-pos (find-pos refresh &optional pos)
"Search for toot with FIND-POS.
@@ -354,29 +368,26 @@ If LOCAL, get only local timeline.
With a single PREFIX arg, hide-replies.
With a double PREFIX arg, only show posts with media."
(interactive "p")
- (let ((params
- `(("limit" . ,mastodon-tl--timeline-posts-count))))
+ (let ((params `(("limit" . ,mastodon-tl--timeline-posts-count))))
;; avoid adding 'nil' to our params alist:
(when (eq prefix 16)
(push '("only_media" . "true") params))
(when local
(push '("local" . "true") params))
(message "Loading federated timeline...")
- (mastodon-tl--init
- (if local "local" "federated")
- "timelines/public" 'mastodon-tl--timeline nil
- params
- (when (eq prefix 4) t))))
+ (mastodon-tl--init (if local "local" "federated")
+ "timelines/public" 'mastodon-tl--timeline nil
+ params
+ (when (eq prefix 4) t))))
(defun mastodon-tl--get-home-timeline (&optional arg)
"Open home timeline.
With a single prefix ARG, hide replies."
(interactive "p")
(message "Loading home timeline...")
- (mastodon-tl--init
- "home" "timelines/home" 'mastodon-tl--timeline nil
- `(("limit" . ,mastodon-tl--timeline-posts-count))
- (when (eq arg 4) t)))
+ (mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil
+ `(("limit" . ,mastodon-tl--timeline-posts-count))
+ (when (eq arg 4) t)))
(defun mastodon-tl--get-local-timeline (&optional prefix)
"Open local timeline.
@@ -393,7 +404,8 @@ With a single PREFIX arg, only show posts with media.
With a double PREFIX arg, limit results to your own instance."
(interactive "p")
(let* ((word (or (word-at-point) ""))
- (input (or tag (read-string (format "Load timeline for tag (%s): " word))))
+ (input (or tag (read-string
+ (format "Load timeline for tag (%s): " word))))
(tag (or tag (if (string-empty-p input) word input))))
(message "Loading timeline for #%s..." tag)
(mastodon-tl--show-tag-timeline prefix tag)))
@@ -403,8 +415,7 @@ With a double PREFIX arg, limit results to your own instance."
If TAG is a list, show a timeline for all tags.
With a single PREFIX arg, only show posts with media.
With a double PREFIX arg, limit results to your own instance."
- (let ((params
- `(("limit" . ,mastodon-tl--timeline-posts-count))))
+ (let ((params `(("limit" . ,mastodon-tl--timeline-posts-count))))
;; avoid adding 'nil' to our params alist:
(when (eq prefix 4)
(push '("only_media" . "true") params))
@@ -418,7 +429,7 @@ With a double PREFIX arg, limit results to your own instance."
"tags-multiple"
(concat "tag-" tag))
(concat "timelines/tag/" (if (listp tag)
- ;; endpoint needs to be /tag/:sometag
+ ;; endpoint must be /tag/:sth
(car tag) tag))
'mastodon-tl--timeline
nil
@@ -749,7 +760,7 @@ links in the text. If TOOT is nil no parsing occurs."
(insert string)
(let ((shr-use-fonts mastodon-tl--enable-proportional-fonts)
(shr-width (when mastodon-tl--enable-proportional-fonts
- (- (window-width) 1))))
+ (- (window-width) 3))))
(shr-render-region (point-min) (point-max)))
;; Make all links a tab stop recognized by our own logic, make things point
;; to our own logic (e.g. hashtags), and update keymaps where needed:
@@ -1036,8 +1047,7 @@ message is a link which unhides/hides the main body."
(defun mastodon-tl--media-attachment (media-attachment)
"Return a propertized string for MEDIA-ATTACHMENT."
- (let* ((preview-url
- (alist-get 'preview_url media-attachment))
+ (let* ((preview-url (alist-get 'preview_url media-attachment))
(remote-url
(or (alist-get 'remote_url media-attachment)
;; fallback b/c notifications don't have remote_url
@@ -1054,19 +1064,19 @@ message is a link which unhides/hides the main body."
(mastodon-media--get-media-link-rendering
preview-url remote-url type caption) ; 2nd arg for shr-browse-url
;; return URL/caption:
- (concat
- (mastodon-tl--propertize-img-str-or-url
- (concat "Media:: " preview-url) ;; string
- preview-url remote-url type caption
- display-str ;; display
- ;; FIXME: shr-link underlining is awful for captions with
- ;; newlines, as the underlining runs to the edge of the
- ;; frame even if the text doesn'
- 'shr-link)
- "\n"))))
-
-(defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url type
- help-echo &optional display face)
+ (concat (mastodon-tl--propertize-img-str-or-url
+ (concat "Media:: " preview-url) ;; string
+ preview-url remote-url type caption
+ display-str ;; display
+ ;; FIXME: shr-link underlining is awful for captions with
+ ;; newlines, as the underlining runs to the edge of the
+ ;; frame even if the text doesn'
+ 'shr-link)
+ "\n"))))
+
+(defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url
+ type help-echo
+ &optional display face)
"Propertize an media placeholder string \"[img]\" or media URL.
STR is the string to propertize, MEDIA-URL is the preview link,
FULL-REMOTE-URL is the link to the full resolution image on the
@@ -1147,9 +1157,13 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add."
(let ((parsed (ts-human-duration
(ts-diff (ts-parse timestamp) (ts-now)))))
(cond ((> (plist-get parsed :days) 0)
- (format "%s days, %s hours left" (plist-get parsed :days) (plist-get parsed :hours)))
+ (format "%s days, %s hours left"
+ (plist-get parsed :days)
+ (plist-get parsed :hours)))
((> (plist-get parsed :hours) 0)
- (format "%s hours, %s minutes left" (plist-get parsed :hours) (plist-get parsed :minutes)))
+ (format "%s hours, %s minutes left"
+ (plist-get parsed :hours)
+ (plist-get parsed :minutes)))
((> (plist-get parsed :minutes) 0)
(format "%s minutes left" (plist-get parsed :minutes)))
(t ;; we failed to guess:
@@ -1264,8 +1278,21 @@ Runs `mastodon-tl--render-text' and fetches poll or media."
(mastodon-tl--get-poll toot))
(mastodon-tl--media toot))))
+(defun mastodon-tl--prev-toot-id ()
+ "Return the id of the last toot inserted into the buffer."
+ (let ((prev-pos (1- (save-excursion
+ (previous-single-property-change
+ (point)
+ 'base-toot-id)))))
+ (get-text-property prev-pos 'base-toot-id)))
+
+(defun mastodon-tl--after-reply-status (reply-to-id)
+ "T if REPLY-TO-ID is equal to that of the last toot inserted in the bufer."
+ (let ((prev-id (mastodon-tl--prev-toot-id)))
+ (string= reply-to-id prev-id)))
+
(defun mastodon-tl--insert-status (toot body author-byline action-byline
- &optional id base-toot detailed-p)
+ &optional id base-toot detailed-p thread)
"Display the content and byline of timeline element TOOT.
BODY will form the section of the toot above the byline.
AUTHOR-BYLINE is an optional function for adding the author
@@ -1280,14 +1307,30 @@ attached as a `toot-id' property if provided. If the
status is a favourite or boost notification, BASE-TOOT is the
JSON of the toot responded to.
DETAILED-P means display more detailed info. For now
-this just means displaying toot client."
- (let ((start-pos (point)))
+this just means displaying toot client.
+THREAD means the status will be displayed in a thread view."
+ (let* ((start-pos (point))
+ (reply-to-id (alist-get 'in_reply_to_id toot))
+ (after-reply-status-p
+ (when (and thread reply-to-id)
+ (mastodon-tl--after-reply-status reply-to-id))))
(insert
(propertize
- (concat "\n"
- body
- " \n"
- (mastodon-tl--byline toot author-byline action-byline detailed-p))
+ (concat
+ "\n"
+ (if (and after-reply-status-p thread)
+ (concat (mastodon-tl--symbol 'replied)
+ "\n")
+ "")
+ (if (and after-reply-status-p thread)
+ (let ((bar (mastodon-tl--symbol 'reply-bar)))
+ (propertize body
+ 'line-prefix bar
+ 'wrap-prefix bar))
+ body)
+ ;; body
+ " \n"
+ (mastodon-tl--byline toot author-byline action-byline detailed-p))
'toot-id (or id ; notification's own id
(alist-get 'id toot)) ; toot id
'base-toot-id (mastodon-tl--toot-id
@@ -1342,20 +1385,26 @@ To disable showing the stats, customize
(propertize favourites
'favourited-p favourited
'favourites-field t
+ 'help-echo (format "%s favourites" favourites-count)
'face font-lock-comment-face)
(propertize " | " 'face font-lock-comment-face)
(propertize boosts
'boosted-p boosted
'boosts-field t
+ 'help-echo (format "%s boosts" boosts-count)
'face font-lock-comment-face)
(propertize " | " 'face font-lock-comment-face)
(propertize replies
'replies-field t
'replies-count replies-count
+ 'help-echo (format "%s replies" replies-count)
'face font-lock-comment-face)))
- (status (concat
- (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7))))
- status)))
+ (status
+ (concat
+ (propertize " "
+ 'display
+ `(space :align-to (- right ,(+ (length status) 7))))
+ status)))
status)))
(defun mastodon-tl--is-reply (toot)
@@ -1363,10 +1412,11 @@ To disable showing the stats, customize
(and (null (mastodon-tl--field 'in_reply_to_id toot))
(not (mastodon-tl--field 'rebloged toot))))
-(defun mastodon-tl--toot (toot &optional detailed-p)
+(defun mastodon-tl--toot (toot &optional detailed-p thread)
"Format TOOT and insert it into the buffer.
DETAILED-P means display more detailed info. For now
-this just means displaying toot client."
+this just means displaying toot client.
+THREAD means the status will be displayed in a thread view."
(mastodon-tl--insert-status
toot
(mastodon-tl--clean-tabs-and-nl
@@ -1377,12 +1427,15 @@ this just means displaying toot client."
'mastodon-tl--byline-boosted
nil
nil
- detailed-p))
+ detailed-p
+ thread))
-(defun mastodon-tl--timeline (toots)
+(defun mastodon-tl--timeline (toots &optional thread)
"Display each toot in TOOTS.
-This function removes replies if user required."
- (mapc #'mastodon-tl--toot
+This function removes replies if user required.
+THREAD means the status will be displayed in a thread view."
+ (mapc (lambda (toot)
+ (mastodon-tl--toot toot nil thread))
;; hack to *not* filter replies on profiles:
(if (eq (mastodon-tl--get-buffer-type) 'profile-statuses)
toots
@@ -1455,6 +1508,16 @@ HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer."
;;; BUFFERS
+(defun mastodon-tl--endpoint-str-= (str &optional type)
+ "Return T if STR is equal to the current buffer's endpoint.
+TYPE may be :prefix or :suffix, in which case, T if STR is a prefix or suffix."
+ (let ((endpoint-fun (mastodon-tl--get-endpoint nil :no-error)))
+ (cond ((eq type :prefix)
+ (string-prefix-p str endpoint-fun))
+ ((eq type :suffix)
+ (string-suffix-p str endpoint-fun))
+ (t
+ (string= str endpoint-fun)))))
(defun mastodon-tl--get-buffer-type ()
"Return a symbol descriptive of current mastodon buffer type.
@@ -1462,33 +1525,32 @@ Should work in all mastodon buffers.
Note that for many buffers, this requires `mastodon-tl--buffer-spec'
to be set. It is set for almost all buffers, but you still have to
call this function after it is set or use something else."
- (let ((endpoint-fun (mastodon-tl--get-endpoint nil :no-error))
- (buffer-name (mastodon-tl--buffer-name nil :no-error)))
+ (let ((buffer-name (mastodon-tl--buffer-name nil :no-error)))
(cond (mastodon-toot-mode
;; composing/editing:
(if (string= "*edit toot*" (buffer-name))
'edit-toot
'new-toot))
;; main timelines:
- ((string= "timelines/home" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "timelines/home")
'home)
((string= "*mastodon-local*" buffer-name)
'local)
- ((string= "timelines/public" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "timelines/public")
'federated)
- ((string-prefix-p "timelines/tag/" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "timelines/tag/" :prefix)
'tag-timeline)
- ((string-prefix-p "timelines/list/" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "timelines/list/" :prefix)
'list-timeline)
;; notifs:
((string-suffix-p "mentions*" buffer-name)
'mentions)
- ((string= "notifications" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "notifications")
'notifications)
;; threads:
- ((string-suffix-p "context" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "context" :suffix)
'thread)
- ((string-prefix-p "statuses" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "statuses" :prefix)
'single-status)
;; profiles:
((mastodon-tl--profile-buffer-p)
@@ -1505,43 +1567,43 @@ call this function after it is set or use something else."
;; posts inc. boosts:
((string-suffix-p "no-boosts*" buffer-name)
'profile-statuses-no-boosts)
- ((string-suffix-p "statuses" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "statuses" :suffix)
'profile-statuses)
;; profile followers
- ((string-suffix-p "followers" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "followers" :suffix)
'profile-followers)
;; profile following
- ((string-suffix-p "following" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "following" :suffix)
'profile-following)))
- ((string= "preferences" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "preferences")
'preferences)
;; search
- ((string-suffix-p "search" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "search" :suffix)
'search)
;; trends
- ((equal "api/v1/trends/statuses" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "api/v1/trends/statuses")
'trending-statuses)
- ((equal "api/v1/trends/tags" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "api/v1/trends/tags")
'trending-tags)
- ((equal "api/v1/trends/links" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "api/v1/trends/links")
'trending-links)
;; User's views:
- ((string= "filters" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "filters")
'filters)
- ((string= "lists" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "lists")
'lists)
- ((string= "suggestions" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "suggestions")
'follow-suggestions)
- ((string= "favourites" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "favourites")
'favourites)
- ((string= "bookmarks" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "bookmarks")
'bookmarks)
- ((string= "follow_requests" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "follow_requests")
'follow-requests)
- ((string= "scheduled_statuses" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "scheduled_statuses")
'scheduled-statuses)
;; instance description
- ((string= "instance" endpoint-fun)
+ ((mastodon-tl--endpoint-str-= "instance")
'instance-description)
((string= "*mastodon-toot-edits*" buffer-name)
'toot-edits))))
@@ -1559,7 +1621,8 @@ This includes the update profile note buffer, but not the preferences one."
"Return non-nil if the current buffer is a 'proper' timeline.
A proper timeline excludes notifications, threads, and other toot
buffers that aren't strictly mastodon timelines."
- (let ((timeline-buffers '(home federated local tag-timeline list-timeline profile-statuses)))
+ (let ((timeline-buffers
+ '(home federated local tag-timeline list-timeline profile-statuses)))
(member (mastodon-tl--get-buffer-type) timeline-buffers)))
(defun mastodon-tl--hide-replies-p (&optional prefix)
@@ -1567,14 +1630,9 @@ buffers that aren't strictly mastodon timelines."
We hide replies if user explictly set the
`mastodon-tl--hide-replies' or used PREFIX combination to open a
timeline."
- (and
- ;; Only hide replies if we are in a proper timeline
- (mastodon-tl--timeline-proper-p)
- (or
- ;; User configured to hide replies
- mastodon-tl--hide-replies
- ;; Timeline called with C-u prefix
- (equal '(4) prefix))))
+ (and (mastodon-tl--timeline-proper-p) ; Only if we are in a proper timeline
+ (or mastodon-tl--hide-replies ; User configured to hide replies
+ (equal '(4) prefix)))) ; Timeline called with C-u prefix
;;; UTILITIES
@@ -1680,16 +1738,9 @@ ID is that of the toot to view."
(mastodon-http--api (concat "statuses/" id)))))
(if (equal (caar toot) 'error)
(message "Error: %s" (cdar toot))
- (with-current-buffer (get-buffer-create buffer)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (switch-to-buffer buffer)
- (mastodon-mode)
- (mastodon-tl--set-buffer-spec buffer
- (format "statuses/%s" id)
- nil)
- (let ((inhibit-read-only t))
- (mastodon-tl--toot toot :detailed-p)))))))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id) nil)
+ (mastodon-tl--toot toot :detailed-p)))))
(defun mastodon-tl--view-whole-thread ()
"From a thread view, view entire thread.
@@ -1729,25 +1780,21 @@ view all branches of a thread."
(length (alist-get 'descendants context)))
0)
;; if we have a thread:
- (progn
- (with-current-buffer (get-buffer-create buffer)
- (let ((inhibit-read-only t)
- (marker (make-marker)))
- (switch-to-buffer buffer)
- (erase-buffer)
- (mastodon-mode)
- (mastodon-tl--set-buffer-spec buffer
- endpoint
- #'mastodon-tl--thread)
- (mastodon-tl--timeline (alist-get 'ancestors context))
- (goto-char (point-max))
- (move-marker marker (point))
- ;; print re-fetched toot:
- (mastodon-tl--toot toot :detailed-p)
- (mastodon-tl--timeline (alist-get 'descendants context))
- ;; put point at the toot:
- (goto-char (marker-position marker))
- (mastodon-tl--goto-next-toot))))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (let ((marker (make-marker)))
+ (mastodon-tl--set-buffer-spec buffer
+ endpoint
+ #'mastodon-tl--thread)
+ (mastodon-tl--timeline (alist-get 'ancestors context) :thread)
+ (goto-char (point-max))
+ (move-marker marker (point))
+ ;; print re-fetched toot:
+ (mastodon-tl--toot toot :detailed-p :thread)
+ (mastodon-tl--timeline (alist-get 'descendants context)
+ :thread)
+ ;; put point at the toot:
+ (goto-char (marker-position marker))
+ (mastodon-tl--goto-next-toot)))
;; else just print the lone toot:
(mastodon-tl--single-toot id)))))))
@@ -1985,7 +2032,8 @@ Action must be either \"unblock\" or \"unmute\"."
nil ; predicate
t))))
-(defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp notify langs)
+(defun mastodon-tl--do-user-action-and-response
+ (user-handle action &optional negp notify langs)
"Do ACTION on user USER-HANDLE.
NEGP is whether the action involves un-doing something.
If NOTIFY is \"true\", enable notifications when that user posts.
@@ -2004,7 +2052,8 @@ LANGS is an array parameters alist of languages to filer user's posts by."
(mastodon-profile--lookup-account-in-status
user-handle (mastodon-profile--toot-json)))))
(user-id (mastodon-profile--account-field account 'id))
- (name (if (not (string-empty-p (mastodon-profile--account-field account 'display_name)))
+ (name (if (not (string-empty-p
+ (mastodon-profile--account-field account 'display_name)))
(mastodon-profile--account-field account 'display_name)
(mastodon-profile--account-field account 'username)))
(args (cond (notify
@@ -2019,7 +2068,8 @@ LANGS is an array parameters alist of languages to filer user's posts by."
(mastodon-tl--do-user-action-function url name user-handle action args)))
(message "Cannot find a user with handle %S" user-handle))))
-(defun mastodon-tl--do-user-action-function (url name user-handle action &optional notify args)
+(defun mastodon-tl--do-user-action-function
+ (url name user-handle action &optional notify args)
"Post ACTION on user NAME/USER-HANDLE to URL.
NOTIFY is either \"true\" or \"false\", and used when we have been called
by `mastodon-tl--follow-user' to enable or disable notifications.
@@ -2098,7 +2148,8 @@ PREFIX is sent to `mastodon-tl--show-tag-timeline', which see."
(defun mastodon-tl--some-followed-tags-timeline (&optional prefix)
"Prompt for some tags, and open a timeline for them.
-The suggestions are from followed tags, but any other tags are also allowed."
+The suggestions are from followed tags, but any other tags are also allowed.
+PREFIX us sent to `mastodon-tl--show-tag-timeline', which see."
(interactive "p")
(let* ((followed-tags-json (mastodon-tl--followed-tags))
(tags (mastodon-tl--map-alist 'name followed-tags-json))
@@ -2250,7 +2301,10 @@ POS is a number, where point will be placed."
endpoint)
(mastodon-tl--thread
(match-string 2 endpoint))))))
- ;; TODO: sends point to POS, which was where point was in buffer before reload. This is very rough; we may have removed an item (deleted a toot, cleared a notif), so the buffer will be smaller, point will end up past where we were, etc.
+ ;; TODO: sends point to POS, which was where point was in buffer before
+ ;; reload. This is very rough; we may have removed an item (deleted a
+ ;; toot, cleared a notif), so the buffer will be smaller, point will end
+ ;; up past where we were, etc.
(when pos
(goto-char pos)
(mastodon-tl--goto-prev-item))))
@@ -2279,7 +2333,6 @@ when showing followers or accounts followed."
(defun mastodon-tl--more ()
"Append older toots to timeline, asynchronously."
- (interactive)
(message "Loading older toots...")
(if (mastodon-tl--use-link-header-p)
;; link-header: can't build a URL with --more-json-async, endpoint/id:
@@ -2541,44 +2594,30 @@ JSON and http headers, without it just the JSON."
(message "Looks like nothing returned from endpoint: %s" endpoint)
(let* ((headers (if headers (cdr response) nil))
(link-header (mastodon-tl--get-link-header-from-response headers)))
- (with-current-buffer (get-buffer-create buffer)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (switch-to-buffer buffer)
- ;; mastodon-mode wipes buffer-spec, so order must unforch be:
- ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec.
- ;; which means we cannot use buffer-spec for update-function
- ;; unless we set it both before and after the others
- (mastodon-tl--set-buffer-spec buffer
- endpoint
- update-function
- link-header
- update-params
- hide-replies)
- (setq
- ;; Initialize with a minimal interval; we re-scan at least once
- ;; every 5 minutes to catch any timestamps we may have missed
- mastodon-tl--timestamp-next-update (time-add (current-time)
- (seconds-to-time 300)))
- (funcall update-function json)
- (mastodon-mode)
- (mastodon-tl--set-buffer-spec buffer
- endpoint
- update-function
- link-header
- update-params
- hide-replies)
- (setq mastodon-tl--timestamp-update-timer
- (when mastodon-tl--enable-relative-timestamps
- (run-at-time (time-to-seconds
- (time-subtract mastodon-tl--timestamp-next-update
- (current-time)))
- nil ;; don't repeat
- #'mastodon-tl--update-timestamps-callback
- (current-buffer)
- nil)))
- (unless (mastodon-tl--profile-buffer-p)
- (mastodon-tl--goto-first-item))))))))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (mastodon-tl--set-buffer-spec buffer
+ endpoint
+ update-function
+ link-header
+ update-params
+ hide-replies)
+ (funcall update-function json)
+ (setq
+ ;; Initialize with a minimal interval; we re-scan at least once
+ ;; every 5 minutes to catch any timestamps we may have missed
+ mastodon-tl--timestamp-next-update (time-add (current-time)
+ (seconds-to-time 300)))
+ (setq mastodon-tl--timestamp-update-timer
+ (when mastodon-tl--enable-relative-timestamps
+ (run-at-time (time-to-seconds
+ (time-subtract mastodon-tl--timestamp-next-update
+ (current-time)))
+ nil ;; don't repeat
+ #'mastodon-tl--update-timestamps-callback
+ (current-buffer)
+ nil)))
+ (unless (mastodon-tl--profile-buffer-p)
+ (mastodon-tl--goto-first-item)))))))
(defun mastodon-tl--init-sync (buffer-name endpoint update-function &optional note-type)
"Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
@@ -2594,36 +2633,27 @@ Optional arg NOTE-TYPE means only get that type of note."
(url (mastodon-http--api endpoint))
(buffer (concat "*mastodon-" buffer-name "*"))
(json (mastodon-http--get-json url args)))
- (with-current-buffer (get-buffer-create buffer)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (switch-to-buffer buffer)
- ;; mastodon-mode wipes buffer-spec, so order must unforch be:
- ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec.
- ;; which means we cannot use buffer-spec for update-function
- ;; unless we set it both before and after the others
- (mastodon-tl--set-buffer-spec buffer endpoint update-function)
- (setq
- ;; Initialize with a minimal interval; we re-scan at least once
- ;; every 5 minutes to catch any timestamps we may have missed
- mastodon-tl--timestamp-next-update (time-add (current-time)
- (seconds-to-time 300)))
- (funcall update-function json)
- (mastodon-mode)
- (mastodon-tl--set-buffer-spec buffer endpoint update-function nil args)
- (setq mastodon-tl--timestamp-update-timer
- (when mastodon-tl--enable-relative-timestamps
- (run-at-time (time-to-seconds
- (time-subtract mastodon-tl--timestamp-next-update
- (current-time)))
- nil ;; don't repeat
- #'mastodon-tl--update-timestamps-callback
- (current-buffer)
- nil)))
- (unless (mastodon-tl--profile-buffer-p)
- ;; FIXME: this breaks test (because test has empty buffer)
- (mastodon-tl--goto-first-item)))
- buffer)))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (setq
+ ;; Initialize with a minimal interval; we re-scan at least once
+ ;; every 5 minutes to catch any timestamps we may have missed
+ mastodon-tl--timestamp-next-update (time-add (current-time)
+ (seconds-to-time 300)))
+ (funcall update-function json)
+ (mastodon-tl--set-buffer-spec buffer endpoint update-function nil args)
+ (setq mastodon-tl--timestamp-update-timer
+ (when mastodon-tl--enable-relative-timestamps
+ (run-at-time (time-to-seconds
+ (time-subtract mastodon-tl--timestamp-next-update
+ (current-time)))
+ nil ;; don't repeat
+ #'mastodon-tl--update-timestamps-callback
+ (current-buffer)
+ nil)))
+ (unless (mastodon-tl--profile-buffer-p)
+ ;; FIXME: this breaks test (because test has empty buffer)
+ (mastodon-tl--goto-first-item)))
+ buffer))
(provide 'mastodon-tl)
;;; mastodon-tl.el ends here
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index e77ddf3..825831d 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -41,6 +41,11 @@
(require 'cl-lib)
(require 'persist)
(require 'mastodon-iso)
+(require 'facemenu)
+(require 'text-property-search)
+
+(eval-when-compile
+ (require 'mastodon-tl))
(defvar mastodon-instance-url)
(defvar mastodon-tl--buffer-spec)
@@ -130,7 +135,8 @@ You need to install company yourself to use this."
"Display a copy of the toot replied to in the compose buffer."
:type 'boolean)
-(defcustom mastodon-toot-orig-in-reply-length 160
+(defcustom mastodon-toot-orig-in-reply-length 191
+ ;; three lines of divider width: (- (* 3 67) (length " Reply to: "))
"Length to crop toot replied to in the compose buffer to."
:type 'integer)
@@ -147,6 +153,12 @@ If the original toot visibility is different we use the more restricted one."
"Whether to enable your instance's custom emoji by default."
:type 'boolean)
+(defcustom mastodon-toot--proportional-fonts-compose nil
+ "Nonnil to enable using proportional fonts in the compose buffer.
+By default fixed width fonts are used."
+ :type '(boolean :tag "Enable using proportional rather than fixed \
+width fonts"))
+
(defvar-local mastodon-toot--content-warning nil
"A flag whether the toot should be marked with a content warning.")
@@ -214,19 +226,15 @@ to also capture toots that are 'sent' but that don't successfully
send.")
(defvar mastodon-toot-handle-regex
- (concat
- ;; preceding bracket, space or bol [boundary doesn't work with @]
- "\\([(\n\t ]\\|^\\)"
- "\\(?2:@[0-9a-zA-Z._-]+" ; a handle
- "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @
- "\\(\\b\\|'\\)")) ; boundary or ' char
+ (rx (| (any ?\( "\n" "\t "" ") bol) ; preceding things
+ (group-n 2 (+ ?@ (* (any ?- ?_ ?. "A-Z" "a-z" "0-9" ))) ; handle
+ (? ?@ (* (not (any "\n" "\t" " "))))) ; optional domain
+ (| "'" word-boundary))) ; boundary or possessive
(defvar mastodon-toot-tag-regex
- (concat
- ;; preceding bracket, space or bol [boundary doesn't work with #]
- "\\([(\n\t ]\\|^\\)"
- "\\(?2:#[0-9a-zA-Z_]+\\)" ; tag
- "\\(\\b\\|'\\)")) ; boundary or ' char
+ (rx (| (any ?\( "\n" "\t" " ") bol)
+ (group-n 2 ?# (+ (any "A-Z" "a-z" "0-9")))
+ (| "'" word-boundary))) ; boundary or possessive
(defvar mastodon-toot-url-regex
;; adapted from ffap-url-regexp
@@ -329,7 +337,6 @@ boosting, or bookmarking toots."
(defun mastodon-toot--toggle-boost-or-favourite (type)
"Toggle boost or favourite of toot at `point'.
TYPE is a symbol, either `favourite' or `boost.'"
- (interactive)
(mastodon-tl--do-if-toot-strict
(let* ((boost-p (equal type 'boost))
(has-id (mastodon-tl--property 'base-toot-id))
@@ -351,37 +358,41 @@ TYPE is a symbol, either `favourite' or `boost.'"
(visibility (mastodon-tl--field 'visibility
(mastodon-tl--property 'toot-json))))
(if byline-region
- (cond ;; actually there's nothing wrong with faving/boosting own toots!
- ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json))
- ;;(error "You can't %s your own toots" action-string))
- ;; & nothing wrong with faving/boosting own toots from notifs:
- ;; this boosts/faves the base toot, not the notif status
- ((and (equal "reblog" toot-type)
- (not (mastodon-tl--buffer-type-eq 'notifications)))
- (error "You can't %s boosts" action-string))
- ((and (equal "favourite" toot-type)
- (not (mastodon-tl--buffer-type-eq 'notifications)))
- (error "You can't %s favourites" action-string))
- ((and (equal "private" visibility)
- (equal type 'boost))
- (error "You can't boost private toots"))
- (t
- (mastodon-toot--action
- action
- (lambda ()
- (let ((inhibit-read-only t))
- (add-text-properties (car byline-region)
- (cdr byline-region)
- (if boost-p
- (list 'boosted-p (not boosted))
- (list 'favourited-p (not faved))))
- (mastodon-toot--update-stats-on-action type remove)
- (mastodon-toot--action-success
- (if boost-p
- (mastodon-tl--symbol 'boost)
- (mastodon-tl--symbol 'favourite))
- byline-region remove))
- (message (format "%s #%s" (if boost-p msg action) id))))))
+ (if (and (or (equal visibility "direct")
+ (equal visibility "unlisted"))
+ boost-p)
+ (message "You cant boost posts with visibility: %s" visibility)
+ (cond ;; actually there's nothing wrong with faving/boosting own toots!
+ ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json))
+ ;;(error "You can't %s your own toots" action-string))
+ ;; & nothing wrong with faving/boosting own toots from notifs:
+ ;; this boosts/faves the base toot, not the notif status
+ ((and (equal "reblog" toot-type)
+ (not (mastodon-tl--buffer-type-eq 'notifications)))
+ (error "You can't %s boosts" action-string))
+ ((and (equal "favourite" toot-type)
+ (not (mastodon-tl--buffer-type-eq 'notifications)))
+ (error "You can't %s favourites" action-string))
+ ((and (equal "private" visibility)
+ (equal type 'boost))
+ (error "You can't boost private toots"))
+ (t
+ (mastodon-toot--action
+ action
+ (lambda ()
+ (let ((inhibit-read-only t))
+ (add-text-properties (car byline-region)
+ (cdr byline-region)
+ (if boost-p
+ (list 'boosted-p (not boosted))
+ (list 'favourited-p (not faved))))
+ (mastodon-toot--update-stats-on-action type remove)
+ (mastodon-toot--action-success
+ (if boost-p
+ (mastodon-tl--symbol 'boost)
+ (mastodon-tl--symbol 'favourite))
+ byline-region remove))
+ (message (format "%s #%s" (if boost-p msg action) id)))))))
(message (format "Nothing to %s here?!?" action-string))))))
(defun mastodon-toot--inc-or-dec (count subtract)
@@ -496,7 +507,7 @@ With FAVOURITE, list favouriters, else list boosters."
(defun mastodon-toot--copy-toot-url ()
"Copy URL of toot at point.
-If the toot is a fave/boost notification, copy the URLof the
+If the toot is a fave/boost notification, copy the URL of the
base toot."
(interactive)
(let* ((toot (or (mastodon-tl--property 'base-toot)
@@ -892,31 +903,28 @@ instance to edit a toot."
"View editing history of the toot at point in a popup buffer."
(interactive)
(let ((id (mastodon-tl--property 'base-toot-id))
- (history (mastodon-tl--property 'edit-history)))
- (with-current-buffer (get-buffer-create "*mastodon-toot-edits*")
- (let ((inhibit-read-only t))
- (special-mode)
- (erase-buffer)
- (let ((count 1))
- (mapc (lambda (x)
- (insert (propertize (if (= count 1)
- (format "%s [original]:\n" count)
- (format "%s:\n" count))
- 'face font-lock-comment-face)
- (mastodon-toot--insert-toot-iter x)
- "\n")
- (cl-incf count))
- history))
- (switch-to-buffer-other-window (current-buffer))
- (setq-local header-line-format
- (propertize
- (format "Edits to toot by %s:"
- (alist-get 'username
- (alist-get 'account (car history))))
- 'face font-lock-comment-face))
- (mastodon-tl--set-buffer-spec (buffer-name (current-buffer))
- (format "statuses/%s/history" id)
- nil)))))
+ (history (mastodon-tl--property 'edit-history))
+ (buf "*mastodon-toot-edits*"))
+ (with-mastodon-buffer buf #'special-mode :other-window
+ (let ((count 1))
+ (mapc (lambda (x)
+ (insert (propertize (if (= count 1)
+ (format "%s [original]:\n" count)
+ (format "%s:\n" count))
+ 'face font-lock-comment-face)
+ (mastodon-toot--insert-toot-iter x)
+ "\n")
+ (cl-incf count))
+ history))
+ (setq-local header-line-format
+ (propertize
+ (format "Edits to toot by %s:"
+ (alist-get 'username
+ (alist-get 'account (car history))))
+ 'face font-lock-comment-face))
+ (mastodon-tl--set-buffer-spec (buffer-name (current-buffer))
+ (format "statuses/%s/history" id)
+ nil))))
(defun mastodon-toot--insert-toot-iter (it)
"Insert iteration IT of toot."
@@ -1131,12 +1139,12 @@ text of the toot being replied to in the compose buffer."
(mastodon-toot--refresh-attachments-display)
(mastodon-toot--update-status-fields))
-(defun mastodon-toot--attach-media (file content-type description)
- "Prompt for an attachment FILE of CONTENT-TYPE with DESCRIPTION.
+(defun mastodon-toot--attach-media (file description)
+ "Prompt for an attachment FILE with DESCRIPTION.
A preview is displayed in the new toot buffer, and the file
is uploaded asynchronously using `mastodon-toot--upload-attached-media'.
File is actually attached to the toot upon posting."
- (interactive "fFilename: \nsContent type: \nsDescription: ")
+ (interactive "fFilename: \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))
@@ -1145,7 +1153,6 @@ File is actually attached to the toot upon posting."
(setq mastodon-toot--media-attachments
(nconc mastodon-toot--media-attachments
`(((:contents . ,(mastodon-http--read-file-as-string file))
- (:content-type . ,content-type)
(:description . ,description)
(:filename . ,file)))))
(mastodon-toot--refresh-attachments-display)
@@ -1187,12 +1194,11 @@ which is used to attach it to a toot when posting."
(when image-options 'imagemagick)
nil) ; inbuilt scaling in 27.1
t image-options))
- (type (alist-get :content-type attachment))
(description (alist-get :description attachment)))
(setq counter (1+ counter))
(list (format "\n %d: " counter)
image
- (format " \"%s\" (%s)" description type))))
+ (format " \"%s\"" description))))
mastodon-toot--media-attachments))
(list "None")))
@@ -1418,15 +1424,20 @@ LONGEST is the length of the longest binding."
(defun mastodon-toot--format-reply-in-compose-string (reply-text)
"Format a REPLY-TEXT for display in compose buffer docs."
(let* ((rendered (mastodon-tl--render-text reply-text))
- (no-newlines (replace-regexp-in-string "\n\n" "\n" rendered)))
- (concat " Reply to:\n\""
- ;; (propertize
- (truncate-string-to-width
- no-newlines
- mastodon-toot-orig-in-reply-length)
- ;; overridden by containing propertize call:
- ;; 'face 'mastodon-toot-docs-reply-text-face)
- "...\"\n")))
+ (no-props (substring-no-properties rendered))
+ ;; FIXME: this regex replaces \n at end of every post
+ ;; so we have to trim:
+ (no-newlines (string-trim
+ (replace-regexp-in-string "[\n]+" " " no-props)))
+ (reply-to (concat " Reply to: \"" no-newlines "\""))
+ (crop (truncate-string-to-width
+ ;; (string-limit
+ reply-to
+ mastodon-toot-orig-in-reply-length)))
+ (if (> (length no-newlines)
+ (length crop)) ; we cropped:
+ (concat crop "\n")
+ (concat reply-to "\n"))))
(defun mastodon-toot--display-docs-and-status-fields (&optional reply-text)
"Insert propertized text with documentation about `mastodon-toot-mode'.
@@ -1464,12 +1475,14 @@ REPLY-TEXT is the text of the toot being replied to."
'toot-attachments t)
"\n"
(if reply-text
- (mastodon-toot--format-reply-in-compose-string reply-text)
+ (propertize
+ (mastodon-toot--format-reply-in-compose-string reply-text)
+ 'toot-reply t)
"")
divider
"\n")
'rear-nonsticky t
- 'face font-lock-comment-face
+ 'face 'mastodon-toot-docs-face
'read-only "Edit your message below."
'toot-post-header t))))
@@ -1557,7 +1570,8 @@ REPLY-JSON is the full JSON of the toot being replied to."
(defun mastodon-toot--count-toot-chars (toot-string &optional cw)
"Count the characters in TOOT-STRING.
URLs always = 23, and domain names of handles are not counted.
-This is how mastodon does it."
+This is how mastodon does it.
+CW is the content warning, which contributes to the character count."
(with-temp-buffer
(switch-to-buffer (current-buffer))
(insert toot-string)
@@ -1631,11 +1645,12 @@ Added to `after-change-functions'."
(when (mastodon-toot--compose-buffer-p)
(let ((header-region
(mastodon-tl--find-property-range 'toot-post-header
- (point-min))))
+ (point-min)))
+ (face (when mastodon-toot--proportional-fonts-compose
+ 'variable-pitch)))
;; cull any prev props:
;; stops all text after a handle or mention being propertized:
- (set-text-properties (cdr header-region) (point-max) nil)
- ;; TODO: confirm allowed hashtag/handle characters:
+ (set-text-properties (cdr header-region) (point-max) `(face ,face))
(mastodon-toot--propertize-item mastodon-toot-tag-regex
'success
(cdr header-region))
@@ -1660,11 +1675,22 @@ Added to `after-change-functions'."
(or (mastodon-tl--buffer-type-eq 'edit-toot)
(mastodon-tl--buffer-type-eq 'new-toot)))
+(defun mastodon-toot--fill-reply-in-compose ()
+ "Fill reply text in compose buffer to the width of the divider."
+ (save-excursion
+ (save-match-data
+ (let* ((fill-column 67))
+ (goto-char (point-min))
+ ;; while-let shoulndn't be needed here, as we really should only have
+ ;; one. if we have more, the bug is elsewhere.
+ (when-let ((prop (text-property-search-forward 'toot-reply)))
+ (fill-region (prop-match-beginning prop)
+ (point)))))))
+
;; NB: now that we have toot drafts, to ensure offline composing remains
;; possible, avoid any direct requests here:
-(defun mastodon-toot--compose-buffer (&optional reply-to-user
- reply-to-id reply-json initial-text
- edit)
+(defun mastodon-toot--compose-buffer
+ (&optional reply-to-user reply-to-id reply-json initial-text edit)
"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.
@@ -1690,9 +1716,11 @@ EDIT means we are editing an existing toot, not composing a new one."
(mastodon-profile--get-source-pref 'privacy)
"public")) ; fallback
(unless buffer-exists
- (mastodon-toot--display-docs-and-status-fields
- (when mastodon-toot-display-orig-in-reply-buffer
- reply-text))
+ (if mastodon-toot-display-orig-in-reply-buffer
+ (progn
+ (mastodon-toot--display-docs-and-status-fields reply-text)
+ (mastodon-toot--fill-reply-in-compose))
+ (mastodon-toot--display-docs-and-status-fields))
;; `reply-to-user' (alone) is also used by `mastodon-tl--dm-user', so
;; perhaps we should not always call --setup-as-reply, or make its
;; workings conditional on reply-to-id. currently it only checks for
@@ -1706,12 +1734,10 @@ EDIT means we are editing an existing toot, not composing a new one."
(when mastodon-toot--enable-completion
(set ; (setq-local
(make-local-variable 'completion-at-point-functions)
- (add-to-list
- 'completion-at-point-functions
- #'mastodon-toot--mentions-capf))
- (add-to-list
- 'completion-at-point-functions
- #'mastodon-toot--tags-capf)
+ (add-to-list 'completion-at-point-functions
+ #'mastodon-toot--mentions-capf))
+ (add-to-list 'completion-at-point-functions
+ #'mastodon-toot--tags-capf)
;; company
(when (and mastodon-toot--use-company-for-completion
(require 'company nil :no-error))
@@ -1721,20 +1747,42 @@ EDIT means we are editing an existing toot, not composing a new one."
(company-mode-on)))
;; after-change:
(make-local-variable 'after-change-functions)
- (push #'mastodon-toot--update-status-fields after-change-functions)
- (mastodon-toot--refresh-attachments-display)
+ (cl-pushnew #'mastodon-toot--update-status-fields after-change-functions)
+ (cl-pushnew #'mastodon-toot--save-toot-text after-change-functions)
+ (cl-pushnew #'mastodon-toot--propertize-tags-and-handles after-change-functions)
(mastodon-toot--update-status-fields)
+ (mastodon-toot--propertize-tags-and-handles)
+ (mastodon-toot--refresh-attachments-display)
;; draft toot text saving:
(setq mastodon-toot-current-toot-text nil)
- (push #'mastodon-toot--save-toot-text after-change-functions)
- (push #'mastodon-toot--propertize-tags-and-handles after-change-functions)
;; if we set this before changing modes, it gets nuked:
(setq mastodon-toot-previous-window-config previous-window-config)
+ (when mastodon-toot--proportional-fonts-compose
+ (facemenu-set-face 'variable-pitch))
(when initial-text
(insert initial-text))))
+;; flyspell ignore masto toot regexes:
+(defvar flyspell-generic-check-word-predicate)
+(defun mastodon-toot-mode-flyspell-verify ()
+ "A predicate function for `flyspell'.
+Only text that is not one of these faces will be spell-checked."
+ (let ((faces '(mastodon-display-name-face
+ mastodon-toot-docs-face font-lock-comment-face
+ success link)))
+ (unless (eql (point) (point-min))
+ ;; (point) is next char after the word. Must check one char before.
+ (let ((f (get-text-property (1- (point)) 'face)))
+ (not (memq f faces))))))
+
+(add-hook 'mastodon-toot-mode-hook
+ (lambda ()
+ (setq flyspell-generic-check-word-predicate
+ 'mastodon-toot-mode-flyspell-verify)))
+
;;;###autoload
-(add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe)
+(add-hook 'mastodon-toot-mode-hook
+ #'mastodon-profile--fetch-server-account-settings-maybe)
;; disable auto-fill-mode:
(add-hook 'mastodon-toot-mode-hook
diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el
index 8064282..4f102a6 100644
--- a/lisp/mastodon-views.el
+++ b/lisp/mastodon-views.el
@@ -36,8 +36,12 @@
(require 'cl-lib)
(require 'mastodon-http)
+(eval-when-compile
+ (require 'mastodon-tl))
(defvar mastodon-mode-map)
+(defvar mastodon-tl--horiz-bar)
+(defvar mastodon-tl--timeline-posts-count)
(autoload 'mastodon-mode "mastodon")
(autoload 'mastodon-tl--init "mastodon-tl")
@@ -797,30 +801,22 @@ INSTANCE is the instance were are working with."
(let* ((domain (url-file-nondirectory instance))
(buf (get-buffer-create
(format "*mastodon-instance-%s*" domain))))
- (with-current-buffer buf
- (switch-to-buffer-other-window buf)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (special-mode)
- (when brief
- (setq response
- (list (assoc 'uri response)
- (assoc 'title response)
- (assoc 'short_description response)
- (assoc 'email response)
- (cons 'contact_account
- (list
- (assoc 'username
- (assoc 'contact_account response))))
- (assoc 'rules response)
- (assoc 'stats response))))
- (mastodon-views--print-json-keys response)
- ;; (mastodon-mode) ; breaks our 'q' binding that avoids leaving
- ;; split window
- (mastodon-tl--set-buffer-spec (buffer-name buf)
- "instance"
- nil)
- (goto-char (point-min)))))))
+ (with-mastodon-buffer buf #'special-mode :other-window
+ (when brief
+ (setq response
+ (list (assoc 'uri response)
+ (assoc 'title response)
+ (assoc 'short_description response)
+ (assoc 'email response)
+ (cons 'contact_account
+ (list
+ (assoc 'username
+ (assoc 'contact_account response))))
+ (assoc 'rules response)
+ (assoc 'stats response))))
+ (mastodon-views--print-json-keys response)
+ (mastodon-tl--set-buffer-spec (buffer-name buf) "instance" nil)
+ (goto-char (point-min))))))
(defun mastodon-views--format-key (el pad)
"Format a key of element EL, a cons, with PAD padding."
@@ -902,8 +898,8 @@ IND is the optional indentation level to print at."
(indent-to 4)
(insert
(format "%-5s: "
- (propertize key)
- 'face '(:underline t))
+ (propertize key
+ 'face '(:underline t)))
(mastodon-views--newline-if-long value)
(format "%s" (mastodon-tl--render-text
value))
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 980e31f..21bd763 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -1,4 +1,4 @@
-;;; mastodon.el --- Client for fediverse services that implement the Mastodon API -*- lexical-binding: t -*-
+;;; mastodon.el --- Client for fediverse services using the Mastodon API -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2020-2022 Marty Hiatt
@@ -29,8 +29,11 @@
;;; Commentary:
-;; mastodon.el is a client for fediverse services that implement the Mastodon API. See <https://github.com/mastodon/mastodon>.
-;; See the readme file at https://codeberg.org/martianh/mastodon.el for set up and usage details.
+;; mastodon.el is a client for fediverse services that implement the Mastodon
+;; API. See <https://github.com/mastodon/mastodon>.
+
+;; See the readme file at https://codeberg.org/martianh/mastodon.el for set up
+;; and usage details.
;;; Code:
(require 'cl-lib) ; for `cl-some' call in mastodon
@@ -241,6 +244,18 @@ Use. e.g. \"%c\" for your locale's date and time format."
'((t :inherit success))
"Face used for content warning.")
+(defface mastodon-toot-docs-face
+ `((t :inherit font-lock-comment-face))
+ "Face used for documentation in toot compose buffer.
+If `mastodon-tl--enable-proportional-fonts' is changed,
+mastodon.el needs to be re-loaded for this to be correctly set.")
+
+(defface mastodon-toot-docs-reply-text-face
+ `((t :inherit font-lock-comment-face
+ :family ,(face-attribute 'variable-pitch :family)))
+ "Face used for reply text in toot compose buffer.
+See `mastodon-toot-display-orig-in-reply-buffer'.")
+
;;;###autoload
(defun mastodon ()
"Connect Mastodon client to `mastodon-instance-url' instance."
diff --git a/test/ert-helper.el b/test/ert-helper.el
index 9c85dfb..4e634b0 100644
--- a/test/ert-helper.el
+++ b/test/ert-helper.el
@@ -1,5 +1,6 @@
(load-file "lisp/mastodon-http.el")
(load-file "lisp/mastodon-iso.el")
+(load-file "lisp/mastodon-tl.el")
(load-file "lisp/mastodon-toot.el")
(load-file "lisp/mastodon-search.el")
(load-file "lisp/mastodon.el")
@@ -11,7 +12,6 @@
(load-file "lisp/mastodon-media.el")
(load-file "lisp/mastodon-notifications.el")
(load-file "lisp/mastodon-profile.el")
-(load-file "lisp/mastodon-tl.el")
(load-file "lisp/mastodon-async.el")
;; load tests in bulk to avoid using deprecated `cask exec'
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 16:36:35 +0000