diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-http.el | 34 | ||||
| -rw-r--r-- | lisp/mastodon-media.el | 35 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 26 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 3 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 84 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 1 |
6 files changed, 113 insertions, 70 deletions
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 69a571d..d677e57 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -132,15 +132,15 @@ Used for API form data parameters that take an array." (cl-loop for x in array collect (cons param-str x))) -(defun mastodon-http--post (url &optional args headers unauthenticated-p) - "POST synchronously to URL, optionally with ARGS and HEADERS. +(defun mastodon-http--post (url &optional params headers unauthenticated-p) + "POST synchronously to URL, optionally with PARAMS and HEADERS. Authorization header is included by default unless UNAUTHENTICATED-P is non-nil." (mastodon-http--authorized-request "POST" (let ((url-request-data - (when args - (mastodon-http--build-params-string args))) + (when params + (mastodon-http--build-params-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -237,11 +237,12 @@ PARAMS is an alist of any extra parameters to send with the request." (defun mastodon-http--put (url &optional params headers) "Make PUT request to URL. -PARAMS is an alist of any extra parameters to send with the request." +PARAMS is an alist of any extra parameters to send with the request. +HEADERS is an alist of any extra headers to send with the request." (mastodon-http--authorized-request "PUT" (let ((url-request-data - (when args (mastodon-http--build-params-string params))) + (when params (mastodon-http--build-params-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -288,35 +289,36 @@ PARAMS is an alist of any extra parameters to send with the request." "GET" (url-retrieve url callback cbargs)))) -(defun mastodon-http--get-response-async (url &optional params callback &rest args) - "Make GET request to URL. Call CALLBACK with http response and ARGS." +(defun mastodon-http--get-response-async (url &optional params callback &rest cbargs) + "Make GET request to URL. Call CALLBACK with http response and CBARGS. +PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async url params (lambda (status) (when status ;; only when we actually get sth? - (apply callback (mastodon-http--process-response) args))))) + (apply callback (mastodon-http--process-response) cbargs))))) -(defun mastodon-http--get-json-async (url &optional params callback &rest args) - "Make GET request to URL. Call CALLBACK with json-list and ARGS. +(defun mastodon-http--get-json-async (url &optional params callback &rest cbargs) + "Make GET request to URL. Call CALLBACK with json-list and CBARGS. PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async url params (lambda (status) (when status ;; only when we actually get sth? - (apply callback (mastodon-http--process-json) args))))) + (apply callback (mastodon-http--process-json) cbargs))))) -(defun mastodon-http--post-async (url args headers &optional callback &rest cbargs) - "POST asynchronously to URL with ARGS and HEADERS. +(defun mastodon-http--post-async (url params headers &optional callback &rest cbargs) + "POST asynchronously to URL with PARAMS and HEADERS. Then run function CALLBACK with arguements CBARGS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (mastodon-http--authorized-request "POST" (let ((request-timeout 5) (url-request-data - (when args - (mastodon-http--build-params-string args)))) + (when params + (mastodon-http--build-params-string params)))) (with-temp-buffer (url-retrieve url callback cbargs))))) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 9715a6c..c783130 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -35,6 +35,8 @@ ;;; Code: (require 'url-cache) +(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl") + (defvar url-show-status) (defvar mastodon-tl--shr-image-map-replacement) @@ -306,34 +308,23 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type caption) +(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url + type caption) "Return the string to be written that renders the image at MEDIA-URL. FULL-REMOTE-URL is used for `shr-browse-image'. TYPE is the attachment's type field on the server. CAPTION is the image caption if provided." (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview") - (help-echo (if caption - (concat help-echo-base - "\n\"" - caption "\"") - help-echo-base))) + (help-echo (if caption + (concat help-echo-base + "\n\"" + caption "\"") + help-echo-base))) (concat - (propertize "[img]" - 'media-url media-url - 'media-state 'needs-loading - 'media-type 'media-link - 'mastodon-media-type type - 'display (create-image mastodon-media--generic-broken-image-data nil t) - 'mouse-face 'highlight - 'mastodon-tab-stop 'image ; for do-link-action-at-point - 'image-url full-remote-url ; for shr-browse-image - 'keymap mastodon-tl--shr-image-map-replacement - 'help-echo (if (or (string= type "image") - (string= type nil) - (string= type "unknown")) ;handle borked images - help-echo - (concat help-echo "\nC-RET: play " type " with mpv"))) - " "))) + (mastodon-tl--propertize-img-str-or-url + "[img]" media-url full-remote-url type help-echo + (create-image mastodon-media--generic-broken-image-data nil t)) + " "))) (provide 'mastodon-media) ;;; mastodon-media.el ends here diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 69cd65d..3ba00b9 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -113,7 +113,6 @@ (define-minor-mode mastodon-profile-mode "Toggle mastodon profile minor mode. - This minor mode is used for mastodon profile pages and adds a couple of extra keybindings." :init-value nil @@ -154,7 +153,8 @@ contains") (mastodon-tl--property 'toot-json)) (defun mastodon-profile--make-author-buffer (account &optional no-reblogs) - "Take an ACCOUNT json and insert a user account into a new buffer." + "Take an ACCOUNT json and insert a user account into a new buffer. +NO-REBLOGS means do not display boosts in statuses." (mastodon-profile--make-profile-buffer-for account "statuses" #'mastodon-tl--timeline no-reblogs)) @@ -553,7 +553,8 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function &optional no-reblogs) - "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION." + "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. +NO-REBLOGS means do not display boosts in statuses." (let* ((id (mastodon-profile--account-field account 'id)) (args (when no-reblogs '(("exclude_reblogs" . "t")))) (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) @@ -616,15 +617,18 @@ FIELDS means provide a fields vector fetched by other means." " [locked]") "") "\n ------------\n" - (mastodon-tl--render-text note account) + ;; 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") + 'success)) "") + "\n" + ;; Joined date: (propertize (mastodon-profile--format-joined-date-string joined) 'face 'success) @@ -664,7 +668,7 @@ FIELDS means provide a fields vector fetched by other means." (goto-char (point-min)))) (defun mastodon-profile--format-joined-date-string (joined) - "Format a Joined timestamp." + "Format a human-readable Joined string from timestamp JOINED." (let ((joined-ts (ts-parse joined))) (format "Joined %s" (concat (ts-month-name joined-ts) " " @@ -673,7 +677,6 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--get-toot-author () "Open profile of author of toot under point. - If toot is a boost, opens the profile of the booster." (interactive) (mastodon-profile--make-author-buffer @@ -729,7 +732,6 @@ IMG_TYPE is the JSON key from the account data." (defun mastodon-profile--account-field (account field) "Return FIELD from the ACCOUNT. - FIELD is used to identify regions under 'account" (cdr (assoc field account))) @@ -760,7 +762,6 @@ Used to view a user's followers and those they're following." (defun mastodon-profile--search-account-by-handle (handle) "Return an account based on a user's HANDLE. - If the handle does not match a search return then retun NIL." (let* ((handle (if (string= "@" (substring handle 0 1)) (substring handle 1 (length handle)) @@ -783,15 +784,14 @@ If the handle does not match a search return then retun NIL." (defun mastodon-profile--extract-users-handles (status) "Return all user handles found in STATUS. - These include the author, author of reblogged entries and any user mentioned." (when status (let ((this-account (or (alist-get 'account status) ; status is a toot status)) ; status is a user listing - (mentions (or (alist-get 'mentions (alist-get 'status status)) + (mentions (or (alist-get 'mentions (alist-get 'status status)) (alist-get 'mentions status))) - (reblog (or (alist-get 'reblog (alist-get 'status status)) + (reblog (or (alist-get 'reblog (alist-get 'status status)) (alist-get 'reblog status)))) (seq-filter 'stringp diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 7ff8b07..9d8ee65 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -180,8 +180,7 @@ user's profile note. This is also called by json)) (defun mastodon-search--propertize-user (acct &optional note) - "Propertize display string for ACCT, optionally including profile -NOTE." + "Propertize display string for ACCT, optionally including profile NOTE." (let ((user (mastodon-search--get-user-info acct))) (propertize (concat (propertize (car user) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e65d3a5..1a726c4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -107,6 +107,13 @@ By default fixed width fonts are used." :type '(boolean :tag "Enable using proportional rather than fixed \ width fonts when rendering HTML text")) +(defcustom mastodon-tl--display-caption-not-url-when-no-media t + "Display an image's caption rather than URL. +Only has an effect when `mastodon-tl--display-media-p' is set to +nil." + :group 'mastodon-tl + :type 'boolean) + (defvar-local mastodon-tl--buffer-spec nil "A unique identifier and functions for each Mastodon buffer.") @@ -684,7 +691,7 @@ this just means displaying toot client." (mastodon-tl--relative-time-description edited-parsed) edited-parsed))) "") - (propertize "\n ------------\n " 'face 'default)) + (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted 'bookmarked-p bookmarked @@ -1031,27 +1038,70 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists." - (let* ((media-attachements (mastodon-tl--field 'media_attachments toot)) - (media-string (mapconcat - (lambda (media-attachement) - (let ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement))) - (if mastodon-tl--display-media-p - (mastodon-media--get-media-link-rendering - preview-url remote-url type caption) ; 2nd arg for shr-browse-url - (concat "Media::" preview-url "\n")))) - media-attachements ""))) + (let* ((media-attachments (mastodon-tl--field 'media_attachments toot)) + (media-string (mapconcat #'mastodon-tl--media-attachment + media-attachments ""))) (if (not (and mastodon-tl--display-media-p (string-empty-p media-string))) (concat "\n" media-string) ""))) +(defun mastodon-tl--media-attachment (media-attachment) + "Return a propertized string for 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 + (alist-get 'url media-attachment))) + (type (alist-get 'type media-attachment)) + (caption (alist-get 'description media-attachment)) + (display-str + (if (and mastodon-tl--display-caption-not-url-when-no-media + caption) + (concat "Media:: " caption) + (concat "Media:: " preview-url)))) + (if mastodon-tl--display-media-p + ;; return placeholder [img]: + (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) + "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 +server, TYPE is the media type. +HELP-ECHO, DISPLAY, and FACE are the text properties to add." + (propertize str + 'media-url media-url + 'media-state (when (string= str "[img]") 'needs-loading) + 'media-type 'media-link + 'mastodon-media-type type + 'display display + 'face face + 'mouse-face 'highlight + 'mastodon-tab-stop 'image ; for do-link-action-at-point + 'image-url full-remote-url ; for shr-browse-image + 'keymap mastodon-tl--shr-image-map-replacement + 'help-echo (if (or (string= type "image") + (string= type nil) + (string= type "unknown")) ;handle borked images + help-echo + (concat help-echo "\nC-RET: play " type " with mpv")))) + (defun mastodon-tl--content (toot) "Retrieve text content from TOOT. Runs `mastodon-tl--render-text' and fetches poll or media." diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b12e7e1..1e364df 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -78,6 +78,7 @@ (autoload 'mastodon-http--build-array-params-alist "mastodon-http") (autoload 'mastodon-tl--get-endpoint "mastodon-tl") (autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-tl--return-fave-char "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") |