Merge branch 'develop'

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)