aboutsummaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/mastodon-profile.el19
-rw-r--r--lisp/mastodon-tl.el144
-rw-r--r--lisp/mastodon-toot.el72
-rw-r--r--lisp/mastodon.el2
4 files changed, 152 insertions, 85 deletions
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index de16b7d..cd1978f 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -35,7 +35,6 @@
;;; Code:
(require 'seq)
(require 'cl-lib)
-(require 'persist)
(require 'parse-time)
(require 'mastodon-http)
(eval-when-compile
@@ -125,8 +124,8 @@ It contains details of the current user's account.")
map)
"Keymap for `mastodon-profile-update-mode'.")
-(persist-defvar mastodon-profile-account-settings nil
- "An alist of account settings saved from the server.
+(define-multisession-variable mastodon-profile-account-settings nil
+ "An alist of account settings saved from the server.
Other clients can change these settings on the server at any
time, so this list is not the canonical source for settings. It
is updated on entering mastodon mode and on toggle any setting it
@@ -365,13 +364,16 @@ SOURCE means that the preference is in the `source' part of the account JSON."
(defun mastodon-profile--get-pref (pref)
"Return PREF from `mastodon-profile-account-settings'."
- (plist-get mastodon-profile-account-settings pref))
+ (plist-get (multisession-value mastodon-profile-account-settings)
+ pref))
(defun mastodon-profile--update-preference-plist (pref val)
"Set local account preference plist preference PREF to VAL.
This is done after changing the setting on the server."
- (setq mastodon-profile-account-settings
- (plist-put mastodon-profile-account-settings pref val)))
+ (setf (multisession-value mastodon-profile-account-settings)
+ (plist-put
+ (multisession-value mastodon-profile-account-settings)
+ pref val)))
;; used in toot.el
(defun mastodon-profile--fetch-server-account-settings-maybe ()
@@ -384,7 +386,8 @@ Only do so if `mastodon-profile-account-settings' is nil."
Store the values in `mastodon-profile-account-settings'.
Run in `mastodon-mode-hook'.
If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil."
- (unless (and no-force mastodon-profile-account-settings)
+ (unless (and no-force
+ (multisession-value mastodon-profile-account-settings))
(let ((keys '(locked discoverable display_name bot))
(source-keys '(privacy sensitive language)))
(mapc (lambda (k)
@@ -402,7 +405,7 @@ If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil."
;; TODO: remove now redundant vars, replace with fetchers from the plist
(setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy)
mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive))
- mastodon-profile-account-settings)))
+ (multisession-value mastodon-profile-account-settings))))
(defun mastodon-profile--account-locked-toggle ()
"Toggle the locked status of your account.
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 128298d..cb7ccf1 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -89,6 +89,8 @@
(autoload 'mastodon-search--insert-heading "mastodon-search")
(autoload 'mastodon-media--process-full-sized-image-response "mastodon-media")
(autoload 'mastodon-search--trending-statuses "mastodon-search")
+(autoload 'mastodon-search--format-heading "mastodon-search")
+(autoload 'mastodon-toot--with-toot-item "mastodon-toot")
(defvar mastodon-toot--visibility)
(defvar mastodon-toot-mode)
@@ -219,6 +221,13 @@ respects the user's `browse-url' settings."
See `mastodon-tl--get-remote-local-timeline' for view remote local domains."
:type '(repeat string))
+
+(defcustom mastodon-tl--fold-toots-at-length 1200
+ "Length, in characters, to fold a toot at.
+Longer toots will be folded and the remainder replaced by a
+\"read more\" button. If the value is nil, don't fold at all."
+ :type '(integer))
+
;;; VARIABLES
@@ -239,9 +248,8 @@ If nil `(point-min)' is used instead.")
"The timer that, when set will scan the buffer to update the timestamps.")
(defvar mastodon-tl--horiz-bar
- (if (char-displayable-p ?―)
- (make-string 12 ?―)
- (make-string 12 ?-)))
+ (make-string 12
+ (if (char-displayable-p ?―) ?― ?-)))
;;; KEYMAPS
@@ -980,6 +988,8 @@ the toot)."
LINK-TYPE is the type of link to produce."
(let ((help-text (cond ((eq link-type 'content-warning)
"Toggle hidden text")
+ ((eq link-type 'read-more)
+ "Toggle full post")
(t
(error "Unknown link type %s" link-type)))))
(propertize string
@@ -1021,6 +1031,8 @@ Used for hitting RET on a given link."
"Search for account returned nothing. Perform URL lookup?")
(mastodon-url-lookup (get-text-property position 'shr-url))
(message "Unable to find account."))))))))
+ ((eq link-type 'read-more)
+ (mastodon-tl--unfold-post))
(t
(error "Unknown link type %s" link-type)))))
@@ -1361,7 +1373,7 @@ displayed when the duration is smaller than a minute)."
cell))
options-alist)))
(if (null poll)
- (message "No poll here.")
+ (user-error "No poll here")
(list
;; var "option" = just the cdr, a cons of option number and desc
(cdr (assoc (completing-read "Poll option to vote for: "
@@ -1373,7 +1385,7 @@ displayed when the duration is smaller than a minute)."
"If there is a poll at point, prompt user for OPTION to vote on it."
(interactive (mastodon-tl--read-poll-option))
(if (null (mastodon-tl--field 'poll (mastodon-tl--property 'item-json)))
- (message "No poll here.")
+ (user-error "No poll here")
(let* ((toot (mastodon-tl--property 'item-json))
(poll (mastodon-tl--field 'poll toot))
(poll-id (alist-get 'id poll))
@@ -1527,12 +1539,13 @@ When DOMAIN, force inclusion of user's domain in their handle."
(concat (mastodon-tl--symbol 'replied)
"\n")
"")
- (if (and after-reply-status-p thread)
- (let ((bar (mastodon-tl--symbol 'reply-bar)))
+ (let ((bar (mastodon-tl--symbol 'reply-bar))
+ (body (mastodon-tl--fold-body-maybe body)))
+ (if (and after-reply-status-p thread)
(propertize body
'line-prefix bar
- 'wrap-prefix bar))
- body)
+ 'wrap-prefix bar)
+ body))
" \n"
;; byline:
(mastodon-tl--byline toot author-byline action-byline detailed-p domain))
@@ -1552,6 +1565,46 @@ When DOMAIN, force inclusion of user's domain in their handle."
(when mastodon-tl--display-media-p
(mastodon-media--inline-images start-pos (point)))))
+(defun mastodon-tl--fold-body-maybe (body)
+ "Fold toot BODY if it is very long."
+ (if (or (eq nil mastodon-tl--fold-toots-at-length)
+ (length< body mastodon-tl--fold-toots-at-length))
+ body
+ (let* ((heading (mastodon-search--format-heading
+ (mastodon-tl--make-link
+ "READ MORE"
+ 'read-more)))
+ (display (concat (substring body 0
+ mastodon-tl--fold-toots-at-length)
+ heading)))
+ (propertize display
+ 'read-more body))))
+
+(defun mastodon-tl--unfold-post ()
+ "Unfold the toot at point if it is folded (read-more)."
+ (interactive)
+ ;; if at byline, must search backwards:
+ (let* ((byline (mastodon-tl--property 'byline :no-move))
+ (range (mastodon-tl--find-property-range
+ 'read-more (point) byline)))
+ (if (not range)
+ (user-error "No folded item at point?")
+ (let* ((inhibit-read-only t)
+ (body (save-excursion
+ (goto-char (car range))
+ (mastodon-tl--property 'read-more))))
+ ;; `replace-region-contents' is much to slow, our hack from fedi.el is
+ ;; much simpler and much faster
+ (let ((beg (car range))
+ (end (cdr range)))
+ (save-excursion
+ (goto-char beg)
+ (delete-region beg end)
+ (insert body))
+ ;; move point to line where text formerly ended:
+ (goto-char end)
+ (beginning-of-line))))))
+
;; from mastodon-alt.el:
(defun mastodon-tl--toot-for-stats (&optional toot)
"Return the TOOT on which we want to extract stats.
@@ -1979,42 +2032,43 @@ view all branches of a thread."
(defun mastodon-tl--thread (&optional id)
"Open thread buffer for toot at point or with ID."
(interactive)
- (let* ((id (or id (mastodon-tl--property 'base-item-id :no-move)))
- (type (mastodon-tl--field 'type (mastodon-tl--property 'item-json :no-move))))
- (if (or (string= type "follow_request")
- (string= type "follow")) ; no can thread these
- (user-error "No thread")
- (let* ((endpoint (format "statuses/%s/context" id))
- (url (mastodon-http--api endpoint))
- (buffer (format "*mastodon-thread-%s*" id))
- (toot (mastodon-http--get-json ; refetch in case we just faved/boosted:
- (mastodon-http--api (concat "statuses/" id))
- nil :silent))
- (context (mastodon-http--get-json url nil :silent)))
- (if (equal (caar toot) 'error)
- (user-error "Error: %s" (cdar toot))
- (when (member (alist-get 'type toot) '("reblog" "favourite"))
- (setq toot (alist-get 'status toot)))
- (if (> (+ (length (alist-get 'ancestors context))
- (length (alist-get 'descendants context)))
- 0)
- ;; if we have a thread:
- (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-item)))
- ;; else just print the lone toot:
- (mastodon-tl--single-toot id)))))))
+ (mastodon-toot--with-toot-item
+ (let* ((id (or id (mastodon-tl--property 'base-item-id :no-move)))
+ (type (mastodon-tl--field 'type (mastodon-tl--property 'item-json :no-move))))
+ (if (or (string= type "follow_request")
+ (string= type "follow")) ; no can thread these
+ (user-error "No thread")
+ (let* ((endpoint (format "statuses/%s/context" id))
+ (url (mastodon-http--api endpoint))
+ (buffer (format "*mastodon-thread-%s*" id))
+ (toot (mastodon-http--get-json ; refetch in case we just faved/boosted:
+ (mastodon-http--api (concat "statuses/" id))
+ nil :silent))
+ (context (mastodon-http--get-json url nil :silent)))
+ (if (equal (caar toot) 'error)
+ (user-error "Error: %s" (cdar toot))
+ (when (member (alist-get 'type toot) '("reblog" "favourite"))
+ (setq toot (alist-get 'status toot)))
+ (if (> (+ (length (alist-get 'ancestors context))
+ (length (alist-get 'descendants context)))
+ 0)
+ ;; if we have a thread:
+ (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-item)))
+ ;; else just print the lone toot:
+ (mastodon-tl--single-toot id))))))))
(defun mastodon-tl--mute-thread ()
"Mute the thread displayed in the current buffer.
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index ecee301..e1d7259 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -40,7 +40,6 @@
(defvar emojify-user-emojis)
(require 'cl-lib)
-(require 'persist)
(require 'mastodon-iso)
(require 'facemenu)
(require 'text-property-search)
@@ -226,8 +225,8 @@ Takes its form from `window-configuration-to-register'.")
(defvar mastodon-toot-current-toot-text nil
"The text of the toot being composed.")
-(persist-defvar mastodon-toot-draft-toots-list nil
- "A list of toots that have been saved as drafts.
+(define-multisession-variable mastodon-toot-draft-toots-list nil
+ "A list of toots that have been saved as drafts.
For the moment we just put all composed toots in here, as we want
to also capture toots that are \"sent\" but that don't successfully
send.")
@@ -265,7 +264,7 @@ send.")
;;; MACRO
-(defmacro mastodon-tl--with-toot-item (&rest body)
+(defmacro mastodon-toot--with-toot-item (&rest body)
"Execute BODY if we have a toot object at point.
Includes boosts, and notifications that display toots."
(declare (debug t))
@@ -369,7 +368,7 @@ 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.'"
- (mastodon-tl--with-toot-item
+ (mastodon-toot--with-toot-item
(let ((n-type (mastodon-tl--property 'notification-type :no-move)))
(if (or (equal n-type "follow")
(equal n-type "follow_request"))
@@ -472,7 +471,7 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement."
(defun mastodon-toot--toggle-bookmark ()
"Bookmark or unbookmark toot at point."
(interactive)
- (mastodon-tl--with-toot-item
+ (mastodon-toot--with-toot-item
(let ((n-type (mastodon-tl--property 'notification-type :no-move)))
(if (or (equal n-type "follow")
(equal n-type "follow_request"))
@@ -520,7 +519,7 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement."
(defun mastodon-toot--list-toot-boosters-or-favers (&optional favourite)
"List the favouriters or boosters of toot at point.
With FAVOURITE, list favouriters, else list boosters."
- (mastodon-tl--with-toot-item
+ (mastodon-toot--with-toot-item
(let* ((base-toot (mastodon-tl--property 'base-item-id))
(endpoint (if favourite "favourited_by" "reblogged_by"))
(url (mastodon-http--api (format "statuses/%s/%s" base-toot endpoint)))
@@ -719,8 +718,10 @@ CANCEL means the toot was not sent, so we save the toot text as a draft."
(let ((prev-window-config mastodon-toot-previous-window-config))
(unless (eq mastodon-toot-current-toot-text nil)
(when cancel
- (cl-pushnew mastodon-toot-current-toot-text
- mastodon-toot-draft-toots-list :test 'equal)))
+ (setf (multisession-value mastodon-toot-draft-toots-list)
+ (cl-pushnew mastodon-toot-current-toot-text
+ (multisession-value mastodon-toot-draft-toots-list)
+ :test 'equal))))
;; prevent some weird bug when cancelling a non-empty toot:
(delete #'mastodon-toot--save-toot-text after-change-functions)
(quit-window 'kill)
@@ -742,8 +743,10 @@ Pushes `mastodon-toot-current-toot-text' to
`mastodon-toot-draft-toots-list'."
(interactive)
(unless (eq mastodon-toot-current-toot-text nil)
- (cl-pushnew mastodon-toot-current-toot-text
- mastodon-toot-draft-toots-list :test 'equal)
+ (setf (multisession-value mastodon-toot-draft-toots-list)
+ (cl-pushnew mastodon-toot-current-toot-text
+ (multisession-value mastodon-toot-draft-toots-list)
+ :test 'equal))
(message "Draft saved!")))
(defun mastodon-toot--empty-p (&optional text-only)
@@ -955,7 +958,7 @@ instance to edit a toot."
(defun mastodon-toot--edit-toot-at-point ()
"Edit the user's toot at point."
(interactive)
- (mastodon-tl--with-toot-item
+ (mastodon-toot--with-toot-item
(let ((toot (or (mastodon-tl--property 'base-toot) ; fave/boost notifs
(mastodon-tl--property 'item-json))))
(if (not (mastodon-toot--own-toot-p toot))
@@ -1039,7 +1042,7 @@ Remove empty string (self) from result and joins the sequence with whitespace."
"Add domain to local ACCT and replace 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).
+`mastodon-instance-url').
eg. \"yourusername\" -> \"\"
eg. \"feduser@fed.social\" -> \"@feduser@fed.social\"."
(cond ((string-match-p "@" acct) (concat "@" acct)) ; federated acct
@@ -1181,7 +1184,7 @@ text of the toot being replied to in the compose buffer.
If the region is active, inject it into the reply buffer,
prefixed by >."
(interactive)
- (mastodon-tl--with-toot-item
+ (mastodon-toot--with-toot-item
(let* ((quote (when (region-active-p)
(buffer-substring (region-beginning)
(region-end))))
@@ -1539,7 +1542,7 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing."
;;; DISPLAY KEYBINDINGS
(defun mastodon-toot--get-mode-kbinds ()
- "Get a list of the keybindings in the mastodon-toot-mode."
+ "Get a list of the keybindings in the `mastodon-toot-mode'."
(let* ((binds (copy-tree mastodon-toot-mode-map))
(prefix (car (cadr binds)))
(bindings (remove nil (mapcar (lambda (i)
@@ -1552,7 +1555,7 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing."
(defun mastodon-toot--format-kbind-command (cmd)
"Format CMD to be more readable.
-e.g. mastodon-toot--send -> Send."
+e.g. `mastodon-toot--send' -> Send."
(let* ((str (symbol-name cmd))
(re "--\\(.*\\)$")
(str2 (save-match-data
@@ -1608,7 +1611,7 @@ LONGEST is the length of the longest binding."
;;; DISPLAY DOCS
(defun mastodon-toot--make-mode-docs ()
- "Create formatted documentation text for the mastodon-toot-mode."
+ "Create formatted documentation text for the `mastodon-toot-mode'."
(let* ((kbinds (mastodon-toot--get-mode-kbinds))
(longest-kbind (mastodon-toot--formatted-kbinds-longest
(mastodon-toot--format-kbinds kbinds))))
@@ -1841,15 +1844,17 @@ Added to `after-change-functions' in new toot buffers."
(defun mastodon-toot--open-draft-toot ()
"Prompt for a draft and compose a toot with it."
(interactive)
- (if mastodon-toot-draft-toots-list
- (let ((text (completing-read "Select draft toot: "
- mastodon-toot-draft-toots-list
- nil t)))
+ (if (multisession-value mastodon-toot-draft-toots-list)
+ (let ((text (completing-read
+ "Select draft toot: "
+ (multisession-value mastodon-toot-draft-toots-list)
+ nil t)))
(if (mastodon-toot--compose-buffer-p)
(when (and (not (mastodon-toot--empty-p :text-only))
(y-or-n-p "Replace current text with draft?"))
- (cl-pushnew mastodon-toot-current-toot-text
- mastodon-toot-draft-toots-list)
+ (setf (multisession-value mastodon-toot-draft-toots-list)
+ (cl-pushnew mastodon-toot-current-toot-text
+ (multisession-value mastodon-toot-draft-toots-list)))
(goto-char
(cdr (mastodon-tl--find-property-range 'toot-post-header
(point-min))))
@@ -1865,19 +1870,22 @@ Added to `after-change-functions' in new toot buffers."
(defun mastodon-toot--delete-draft-toot ()
"Prompt for a draft toot and delete it."
(interactive)
- (if mastodon-toot-draft-toots-list
- (let ((draft (completing-read "Select draft to delete: "
- mastodon-toot-draft-toots-list
- nil t)))
- (setq mastodon-toot-draft-toots-list
- (cl-delete draft mastodon-toot-draft-toots-list :test #'equal))
+ (if (multisession-value mastodon-toot-draft-toots-list)
+ (let ((draft (completing-read
+ "Select draft to delete: "
+ (multisession-value mastodon-toot-draft-toots-list)
+ nil t)))
+ (setf (multisession-value mastodon-toot-draft-toots-list)
+ (cl-delete draft
+ (multisession-value mastodon-toot-draft-toots-list)
+ :test #'equal))
(message "Draft deleted!"))
(message "No drafts to delete.")))
(defun mastodon-toot--delete-all-drafts ()
"Delete all drafts."
(interactive)
- (setq mastodon-toot-draft-toots-list nil)
+ (setf (multisession-value mastodon-toot-draft-toots-list) nil)
(message "All drafts deleted!"))
@@ -1962,7 +1970,9 @@ EDIT means we are editing an existing toot, not composing a new one."
(mastodon-toot-mode t)
;; set visibility:
(setq mastodon-toot--visibility
- (or (plist-get mastodon-profile-account-settings 'privacy)
+ (or (plist-get
+ (multisession-value mastodon-profile-account-settings)
+ 'privacy)
;; use toot visibility setting from the server:
(mastodon-profile--get-source-value 'privacy)
"public")) ; fallback
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 73a8665..8a0aa91 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -7,7 +7,7 @@
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
;; Version: 1.0.24
-;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4"))
+;; Package-Requires: ((emacs "27.1") (request "0.3.0"))
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 01:03:07 +0000