Adjusted mastodon-tl.el to open user profiles in emacs. (#189)

* Adjusted mastodon-tl.el to open user profiles in emacs.

This also fixes an issue in user profiles where new statuses were insert at the above rather than below the user profile header.

4 files changed, 79 insertions, 25 deletions

diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 9b0e51c..9dc5a82 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -25,17 +25,11 @@
 
 ;;; Commentary:
 
-;; mastodon-profile.el generates stream of users toots.
-;; To fix
-;; 1. Render Image at top of frame [x]
-;; 2. Get toot author [x]
-;; 3. Load more toots [x]
-;; Later
-;; 1. List followers [x]
-;; 2. List people they follow [x]
-;; 3. Option to follow
-;; 4. wheather they follow you or not
-;; 5. Show only Media
+;; mastodon-profile.el generates a stream of users toots.
+;; To add
+;;  - Option to follow
+;;  - wheather they follow you or not
+;;  - Show only Media
 
 ;;; Code:
 
@@ -81,6 +75,7 @@
                   "     TOOTS   \n"
                   " ------------\n")
           'success))
+        (setq mastodon-tl-update-point (point))
         (mastodon-tl--timeline json)))    
     (mastodon-tl--goto-next-toot)))
 
@@ -120,7 +115,6 @@ FIELD is used to identify regions under 'account"
           tootv))
   (mastodon-media--inline-images))
 
-
 (defun mastodon-profile--get-following ()
   "Request a list of those who the user under point follows."
   (interactive)
@@ -155,6 +149,25 @@ STRING is an endpoint, either following or followers."
                           ,'mastodon-profile--add-author-bylines))
       (mastodon-profile--add-author-bylines tootv))))
 
+(defun mastodon-profile--search-account-by-handle (handle)  
+  "Return an account based on a users 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))
+                   handle))
+         (matching-account
+          (remove-if-not
+           (lambda(x) (string= (cdr (assoc 'acct x)) handle))
+           (mastodon-http--get-json
+            (mastodon-http--api (format "accounts/search?q=%s" handle))))))
+    (when (equal 1 (length matching-account))
+      (elt matching-account 0))))
+
+(defun mastodon-profile--account-from-id (user-id)
+  "Request an account object relating to a USER-ID from Mastodon."
+  (mastodon-http--get-json
+   (mastodon-http--api (format "accounts/%s" user-id))))
 
 (provide 'mastodon-profile)
 ;;; mastodon-profile.el ends here
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 00dc50c..4d6d0b6 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -72,6 +72,12 @@ width fonts when rendering HTML text"))
   (image-type-available-p 'imagemagick)
   "A boolean value stating whether to show avatars in timelines.")
 
+(defvar mastodon-tl-update-point nil
+  "When updating a mastodon buffer this is where new toots will be inserted.
+
+If nil `(point-min)' is used instead.")
+(make-variable-buffer-local 'mastodon-tl-update-point)
+
 (defvar mastodon-tl--display-media-p t
   "A boolean value stating whether to show media in timelines.")
 
@@ -244,9 +250,11 @@ Optionally start from POS."
                  'face 'mastodon-handle-face
                  'mouse-face 'highlight
 		 ;; TODO: Replace url browsing with native profile viewing
-		 'mastodon-tab-stop 'shr-url
+		 'mastodon-tab-stop 'user-handle
+                 'account (cdr (assoc 'account toot))
 		 'shr-url profile-url
-		 'keymap mastodon-tl--shr-map-replacement
+		 'keymap mastodon-tl--link-keymap
+                 'mastodon-handle (concat "@" handle)
 		 'help-echo (concat "Browse user profile of @" handle))
      ")")))
 
@@ -414,12 +422,15 @@ links in the text. If TOOT is nil no parsing occurs."
 
           (;; User handles:
            maybe-userhandle
-           ;; Until we have native profile page viewing we leave these as HTML
-           ;; links.
-           (setq mastodon-tab-stop-type 'shr-url
-                 keymap mastodon-tl--shr-map-replacement
-                 help-echo (concat "Browse user profile of " maybe-userhandle)))
-
+           (let ((maybe-userid (mastodon-tl--extract-userid-toot
+                                toot maybe-userhandle)))
+             (setq mastodon-tab-stop-type 'user-handle
+                   keymap mastodon-tl--link-keymap
+                   help-echo (concat "Browse user profile of " maybe-userhandle)
+                   extra-properties (append
+                                     (list 'mastodon-handle maybe-userhandle)
+                                     (when maybe-userid
+                                       (list 'acccount-id maybe-userid))))))
           ;; Anything else:
           (t
            ;; Leave it as a url handled by shr.el.
@@ -435,6 +446,19 @@ links in the text. If TOOT is nil no parsing occurs."
                                 'help-echo help-echo)
                           extra-properties))))
 
+(defun mastodon-tl--extract-userid-toot (toot acct)
+  "Extract a user id for an ACCT from mentions in a TOOT."
+  (let* ((mentions (append (cdr (assoc 'mentions toot)) nil))
+         (mention (pop mentions))
+         (short-acct (substring acct 1 (length acct)))
+         return)
+    (while mention
+      (when (string= (cdr (assoc 'acct mention))
+                     short-acct)
+        (setq return (cdr (assoc 'id  mention))))
+      (setq mention (pop mentions)))    
+    return))
+      
 (defun mastodon-tl--extract-userhandle-from-url (url buffer-text)
   "Returns the user hande the URL points to or nil if it is not a profile link.
 
@@ -520,6 +544,20 @@ LINK-TYPE is the type of link to produce."
            (mastodon-tl--toggle-spoiler-text position))
           ((eq link-type 'hashtag)
            (mastodon-tl--show-tag-timeline (get-text-property position 'mastodon-tag)))
+          ((eq link-type 'user-handle)
+           (let ((account-json (get-text-property position 'account))
+                 (account-id (get-text-property position 'account-id)))
+             (cond
+              (account-json
+               (mastodon-profile--make-author-buffer
+                account-json))
+              (account-id
+               (mastodon-profile--make-author-buffer
+                (mastodon-profile--account-from-id account-id)))
+              (t
+               (mastodon-profile--make-author-buffer
+                (mastodon-profile--search-account-by-handle
+                 (get-text-property position 'mastodon-handle)))))))
           (t
            (error "unknown link type %s" link-type)))))
 
@@ -902,7 +940,7 @@ from the start if it is nil."
          (json (mastodon-tl--updated-json endpoint id)))
     (when json
       (let ((inhibit-read-only t))
-        (goto-char (point-min))
+        (goto-char (or mastodon-tl-update-point (point-min)))
         (funcall update-function json)))))
 
 (defun mastodon-tl--init (buffer-name endpoint update-function)
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 1b040a9..c71623c 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -50,6 +50,7 @@
 (autoload 'mastodon-toot--toggle-favourite "mastodon-toot")
 (autoload 'mastodon-profile--get-next-author "mastodon-profile")
 (autoload 'mastodon-notifications--get "mastodon-notifications")
+(autoload 'mastodon-profile--make-author-buffer "mastodon-profile")
 
 (defgroup mastodon nil
   "Interface with Mastodon."
diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el
index b2f51c7..f7c6091 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -266,7 +266,9 @@ a string or a numeric."
  | Account 42 (@acct42@example.space) 2999-99-99 00:11:22
   ------------"))
 	(should (eq (get-text-property handle-location 'mastodon-tab-stop byline)
-                'shr-url))
+                    'user-handle))
+        (should (string= (get-text-property handle-location 'mastodon-handle byline)
+                         "@acct42@example.space"))
 	(should (equal (get-text-property handle-location 'help-echo byline)
                    "Browse user profile of @acct42@example.space"))))))
 
@@ -364,11 +366,11 @@ a string or a numeric."
  | Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time
   ------------"))
 	(should (eq (get-text-property handle1-location 'mastodon-tab-stop byline)
-                'shr-url))
+                'user-handle))
 	(should (equal (get-text-property handle1-location 'help-echo byline)
 		       "Browse user profile of @acct42@example.space"))
 	(should (eq (get-text-property handle2-location 'mastodon-tab-stop byline)
-                'shr-url))
+                'user-handle))
 	(should (equal (get-text-property handle2-location 'help-echo byline)
                    "Browse user profile of @acct43@example.space"))))))
 
@@ -946,7 +948,7 @@ constant."
                      mastodon-tl-test-base-toot)))
          (mention-location 11))
     (should (eq (get-text-property mention-location 'mastodon-tab-stop rendered)
-                'shr-url))
+                'user-handle))
     (should (equal (get-text-property mention-location 'help-echo rendered)
                    "Browse user profile of @foo@bar.example"))))