diff options
| -rw-r--r-- | lisp/mastodon-http.el | 20 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 1 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 107 | ||||
| -rw-r--r-- | lisp/mastodon.el | 29 |
4 files changed, 103 insertions, 54 deletions
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 9904232..af1a9da 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -69,7 +69,7 @@ (string-match "[0-9][0-9][0-9]" status-line) (match-string 0 status-line))) -(defun mastodon-http--url-retrieve-synchronously (url) +(defun mastodon-http--url-retrieve-synchronously (url &optional silent) "Retrieve URL asynchronously. This is a thin abstraction over the system @@ -77,7 +77,7 @@ This is a thin abstraction over the system is available we will call it with or without a timeout." (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) - (url-retrieve-synchronously url nil nil mastodon-http--timeout))) + (url-retrieve-synchronously url (or silent nil) nil mastodon-http--timeout))) (defun mastodon-http--triage (response success) "Determine if RESPONSE was successful. Call SUCCESS if successful. @@ -131,17 +131,17 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. (mastodon-http--url-retrieve-synchronously url))) unauthenticated-p)) -(defun mastodon-http--get (url) +(defun mastodon-http--get (url &optional silent) "Make synchronous GET request to URL. Pass response buffer to CALLBACK function." (mastodon-http--authorized-request "GET" - (mastodon-http--url-retrieve-synchronously url))) + (mastodon-http--url-retrieve-synchronously url silent))) -(defun mastodon-http--get-json (url) +(defun mastodon-http--get-json (url &optional silent) "Make synchronous GET request to URL. Return JSON response." - (with-current-buffer (mastodon-http--get url) + (with-current-buffer (mastodon-http--get url silent) (mastodon-http--process-json))) (defun mastodon-http--process-json () @@ -184,14 +184,14 @@ PARAMS should be an alist as required by `url-build-query-string'." (kill-buffer) (json-read-from-string json-string))) -(defun mastodon-http--get-search-json (url query &optional param) +(defun mastodon-http--get-search-json (url query &optional param silent) "Make GET request to URL, searching for QUERY and return JSON response. PARAM is any extra parameters to send with the request." - (let ((buffer (mastodon-http--get-search url query param))) + (let ((buffer (mastodon-http--get-search url query param silent))) (with-current-buffer buffer (mastodon-http--process-json-search)))) -(defun mastodon-http--get-search (base-url query &optional param) +(defun mastodon-http--get-search (base-url query &optional param silent) "Make GET request to BASE-URL, searching for QUERY. Pass response buffer to CALLBACK function. PARAM is a formatted request parameter, eg 'following=true'." @@ -200,7 +200,7 @@ PARAM is a formatted request parameter, eg 'following=true'." (let ((url (if param (concat base-url "?" param "&q=" (url-hexify-string query)) (concat base-url "?q=" (url-hexify-string query))))) - (mastodon-http--url-retrieve-synchronously url)))) + (mastodon-http--url-retrieve-synchronously url silent)))) ;; profile update functions diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 49b5367..c7658ba 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -77,7 +77,6 @@ QUERY is the string to search." (tags (alist-get 'hashtags response))) (mapcar #'mastodon-search--get-hashtag-info tags))) - ;; trending tags (defun mastodon-search--trending-tags () diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8e3ab30..4b0bd9f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -143,6 +143,7 @@ etc.") (define-key map [remap shr-previous-link] 'mastodon-tl--previous-tab-item) ;; keep new my-profile binding; shr 'O' doesn't work here anyway (define-key map (kbd "O") 'mastodon-profile--my-profile) + (define-key map [remap shr-browse-url] 'mastodon-url-lookup) (keymap-canonicalize map)) "The keymap to be set for shr.el generated links that are not images. @@ -1174,6 +1175,13 @@ webapp" (reblog (alist-get 'reblog json))) (if reblog (alist-get 'id reblog) id))) +(defun mastodon-tl--single-toot-from-url (url) + "Open the toot at URL in `mastodon.el'." + ;; TODO: test if URL is masto + ;; FIXME: this only works 1/2 the time + (let ((id (url-file-nondirectory url))) + (mastodon-tl--single-toot id))) + (defun mastodon-tl--single-toot (&optional id) "View toot at point in separate buffer. ID is that of the toot to view." @@ -1190,56 +1198,69 @@ ID is that of the toot to view." (buffer (format "*mastodon-toot-%s*" id)) (toot (mastodon-http--get-json (mastodon-http--api (concat "statuses/" id))))) - (with-output-to-temp-buffer buffer - (switch-to-buffer buffer) - (mastodon-mode) - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "statuses/%s" id) - update-function - (lambda (toot) (message "END of thread.")))) - (let ((inhibit-read-only t)) - (mastodon-tl--toot toot :detailed-p))))) - -(defun mastodon-tl--thread () - "Open thread buffer for toot under `point'." + (if (equal (caar toot) 'error) + (message "Error: %s" (cdar toot)) + (with-output-to-temp-buffer buffer + (switch-to-buffer buffer) + (mastodon-mode) + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,(format "statuses/%s" id) + update-function + (lambda (toot) (message "END of thread.")))) + (let ((inhibit-read-only t)) + (mastodon-tl--toot toot :detailed-p)))))) + +(defun mastodon-tl--thread (&optional id) + "Open thread buffer for toot at point or with ID." (interactive) (let* ((id - (if (equal (mastodon-tl--get-endpoint) "notifications") - ;; for boosts/faves: - (if (mastodon-tl--property 'parent-toot) - (mastodon-tl--as-string (mastodon-tl--toot-id - (mastodon-tl--property 'parent-toot))) - (mastodon-tl--property 'base-toot-id)) - (mastodon-tl--property 'base-toot-id))) + (or id + (if (equal (mastodon-tl--get-endpoint) "notifications") + ;; for boosts/faves: + (if (mastodon-tl--property 'parent-toot) + (mastodon-tl--as-string (mastodon-tl--toot-id + (mastodon-tl--property 'parent-toot))) + (mastodon-tl--property 'base-toot-id)) + (mastodon-tl--property 'base-toot-id)))) (url (mastodon-http--api (format "statuses/%s/context" id))) (buffer (format "*mastodon-thread-%s*" id)) (toot ;; refetch current toot in case we just faved/boosted: (mastodon-http--get-json - (mastodon-http--api (concat "statuses/" id)))) - (context (mastodon-http--get-json url))) - (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) - (progn - (with-output-to-temp-buffer buffer - (switch-to-buffer buffer) - (mastodon-mode) - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "statuses/%s/context" id) - update-function - (lambda (toot) (message "END of thread.")))) - (let ((inhibit-read-only t)) - (mastodon-tl--timeline (alist-get 'ancestors context)) - (goto-char (point-max)) - (mastodon-tl--toot toot :detailed-p) - (mastodon-tl--timeline (alist-get 'descendants context)))) - (mastodon-tl--goto-next-toot)) - (mastodon-tl--single-toot id)))) + (mastodon-http--api (concat "statuses/" id)) + :silent)) + (context (mastodon-http--get-json url :silent)) + (marker (make-marker))) + (if (equal (caar toot) 'error) + (message "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: + (progn + (with-output-to-temp-buffer buffer + (switch-to-buffer buffer) + (mastodon-mode) + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,(format "statuses/%s/context" id) + update-function + (lambda (toot) (message "END of thread.")))) + (let ((inhibit-read-only t)) + (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)) + ;; else just print the lone toot: + (mastodon-tl--single-toot id))))) (defun mastodon-tl--create-filter () "Create a filter for a word. diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 96faf56..a85a7f7 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -33,6 +33,7 @@ ;;; Code: (require 'cl-lib) ; for `cl-some' call in mastodon +(require 'mastodon-http) (require 'mastodon-toot) (declare-function discover-add-context-menu "discover") @@ -264,6 +265,34 @@ If REPLY-JSON is the json of the toot being replied to." (interactive) (mastodon-toot--compose-buffer user reply-to-id reply-json)) +;; URL lookup: should be available even if `mastodon.el' not loaded: + +;;;###autoload +(defun mastodon-url-lookup (&optional query-url) + "Do a WebFinger lookup for QUERY-URL, or the URL at point. +If a status or account is found, load it in `mastodon.el', if +not, just browse the URL in the normal fashion." + (interactive) + (message "Performing lookup...") + (let* ((query (or query-url (url-get-url-at-point))) + (url (format "%s/api/v2/search" mastodon-instance-url)) + (param (concat "resolve=t")) ; webfinger + (response (mastodon-http--get-search-json url query param :silent))) + (if (equal response '((accounts . #1=[]) (statuses . #1#) (hashtags . #1#))) + (shr-browse-url query-url) + (cond ((not (seq-empty-p + (alist-get 'statuses response))) + (let* ((statuses (assoc 'statuses response)) + (status (seq-first (cdr statuses))) + (status-id (alist-get 'id status))) + (mastodon-tl--thread status-id))) + ((not (seq-empty-p + (alist-get 'accounts response))) + (let* ((accounts (assoc 'accounts response)) + (account (seq-first (cdr accounts))) + (account-id (alist-get 'id account))) + (mastodon-profile--account-from-id account-id))))))) + ;;;###autoload (add-hook 'mastodon-mode-hook (lambda () (when (require 'emojify nil :noerror) |