Merge pull request #173 from jdenen/develop

Merge 0.7.2 into master

README.org

@@ -73,24 +73,27 @@ Opens a =*mastodon-home*= buffer in the major mode so you can see toots. You wil
 
 **** Keybindings
 
-|-----+------------------------------------------------|
-| Key | Action                                         |
-|-----+------------------------------------------------|
-| =?= | Open context menu (if =discover= is available) |
-| =b= | Boost toot under =point=                       |
-| =f= | Favourite toot under =point=                   |
-| =F= | Open federated timeline                        |
-| =H= | Open home timeline                             |
-| =j= | Go to next toot                                |
-| =k= | Go to previous toot                            |
-| =L= | Open local timeline                            |
-| =n= | Switch to =mastodon-toot= buffer               |
-| =q= | Quit mastodon buffer. Leave window open.       |
-| =Q= | Quit mastodon buffer and kill window.          |
-| =r= | Reply to toot under =point=.                   |
-| =t= | Open thread buffer for toot under =point=.     |
-| =T= | Prompt for tag and open its timeline           |
-|-----+------------------------------------------------|
+|--------------------------+-----------------------------------------------------------------------------------|
+| Key                      | Action                                                                            |
+|--------------------------+-----------------------------------------------------------------------------------|
+| =?=                      | Open context menu (if =discover= is available)                                    |
+| =b=                      | Boost toot under =point=                                                          |
+| =f=                      | Favourite toot under =point=                                                      |
+| =F=                      | Open federated timeline                                                           |
+| =H=                      | Open home timeline                                                                |
+| =j=                      | Go to next toot                                                                   |
+| =k=                      | Go to previous toot                                                               |
+| =L=                      | Open local timeline                                                               |
+| =n=                      | Switch to =mastodon-toot= buffer                                                  |
+| =q=                      | Quit mastodon buffer. Leave window open.                                          |
+| =Q=                      | Quit mastodon buffer and kill window.                                             |
+| =r=                      | Reply to toot under =point=.                                                      |
+| =t=                      | Open thread buffer for toot under =point=.                                        |
+| =T=                      | Prompt for tag and open its timeline                                              |
+| =<tab>=                  | Go to the next interesting thing that has an action.                              |
+| =<S-tab>=                | Go to the previous interesting thing that has an action.                          |
+| =<return>= / =<mouse-2>= | Perform action for the thing under point (or under mouse for =<mouse-2>=) if any. |
+|--------------------------+-----------------------------------------------------------------------------------|
 
 **** Legend
 

fixture/client.plstore

@@ -1,2 +1,3 @@
 ;;; public entries -*- mode: plstore -*-
-(("mastodon" :client_id "id" :client_secret "secret"))
+(("mastodon-http://other.example" :client_id "id1" :client_secret "secret1")
+ ("mastodon-http://mastodon.example" :client_id "id2" :client_secret "secret2"))

lisp/mastodon-auth.el

@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 2017 Johnson Denen
 ;; Author: Johnson Denen <[email protected]>
-;; Version: 0.7.1
+;; Version: 0.7.2
 ;; Homepage: https://github.com/jdenen/mastodon.el
 ;; Package-Requires: ((emacs "24.4"))
 
@@ -40,8 +40,11 @@
   :prefix "mastodon-auth-"
   :group 'mastodon)
 
-(defvar mastodon-auth--token nil
-  "User access token.")
+(defvar mastodon-auth--token-alist nil
+  "Alist of User access tokens keyed by instance url.")
+
+(defvar mastodon-auth--acct-alist nil
+  "Alist of account accts (name@domain) keyed by instance url.")
 
 (defun mastodon-auth--generate-token ()
   "Make POST to generate auth token."
@@ -53,7 +56,8 @@
      ("username" . ,(read-string "Email: "))
      ("password" . ,(read-passwd "Password: "))
      ("scope" . "read write follow"))
-   nil))
+   nil
+   :unauthenticated))
 
 (defun mastodon-auth--get-token ()
   "Make auth token request and return JSON response."
@@ -67,13 +71,31 @@
       (json-read-from-string json-string))))
 
 (defun mastodon-auth--access-token ()
-  "Return `mastodon-auth--token'.
-
-Generate token and set `mastodon-auth--token' if nil."
-  (or mastodon-auth--token
-      (let* ((json (mastodon-auth--get-token))
-             (token (plist-get json :access_token)))
-        (setq mastodon-auth--token token))))
+  "Return the access token to use with the current `mastodon-instance-url'.
+
+Generate token and set if none known yet."
+  (let ((token
+         (cdr (assoc mastodon-instance-url mastodon-auth--token-alist))))
+    (unless token 
+      (let ((json (mastodon-auth--get-token)))
+        (setq token (plist-get json :access_token))
+        (push (cons mastodon-instance-url token) mastodon-auth--token-alist)))
+    token))
+
+(defun mastodon-auth--get-account-name ()
+  "Request user credentials and return an account name."
+  (cdr (assoc
+        'acct
+        (mastodon-http--get-json
+         (mastodon-http--api
+          "accounts/verify_credentials")))))
+
+(defun mastodon-auth--user-acct ()
+  "Return a mastodon user acct name."
+  (or (cdr (assoc  mastodon-instance-url mastodon-auth--acct-alist))
+      (let ((acct (mastodon-auth--get-account-name)))
+        (push (cons mastodon-instance-url acct) mastodon-auth--acct-alist)
+        acct)))
 
 (provide 'mastodon-auth)
 ;;; mastodon-auth.el ends here

lisp/mastodon-client.el

@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 2017 Johnson Denen
 ;; Author: Johnson Denen <[email protected]>
-;; Version: 0.7.1
+;; Version: 0.7.2
 ;; Homepage: https://github.com/jdenen/mastodon.el
 ;; Package-Requires: ((emacs "24.4"))
 
@@ -30,6 +30,7 @@
 ;;; Code:
 
 (require 'plstore)
+(defvar mastodon-instance-url)
 (autoload 'mastodon-http--api "mastodon-http")
 (autoload 'mastodon-http--post "mastodon-http")
 
@@ -39,8 +40,8 @@
   :group 'mastodon
   :type 'file)
 
-(defvar mastodon-client--client-details nil
-  "Client id and secret.")
+(defvar mastodon-client--client-details-alist nil
+  "An alist of Client id and secrets keyed by the instance url.")
 
 (defun mastodon-client--register ()
   "POST client to Mastodon."
@@ -50,7 +51,8 @@
      ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob")
      ("scopes" . "read write follow")
      ("website" . "https://github.com/jdenen/mastodon.el"))
-   nil))
+   nil
+   :unauthenticated))
 
 (defun mastodon-client--fetch ()
   "Return JSON from `mastodon-client--register' call."
@@ -72,28 +74,38 @@
 
 Make `mastodon-client--fetch' call to determine client values."
   (let ((plstore (plstore-open (mastodon-client--token-file)))
-        (client (mastodon-client--fetch)))
-    (plstore-put plstore "mastodon" client nil)
+	(client (mastodon-client--fetch))
+	;; alexgriffith reported seeing ellipses in the saved output
+	;; which indicate some output truncating. Nothing in `plstore-save'
+	;; seems to ensure this cannot happen so let's do that ourselves:
+	(print-length nil)
+	(print-level nil))
+    (plstore-put plstore (concat "mastodon-" mastodon-instance-url) client nil)
     (plstore-save plstore)
     (plstore-close plstore)
     client))
 
 (defun mastodon-client--read ()
   "Retrieve client_id and client_secret from `mastodon-client--token-file'."
   (let* ((plstore (plstore-open (mastodon-client--token-file)))
-         (mastodon (plstore-get plstore "mastodon")))
-    (when mastodon
-      (delete "mastodon" mastodon))))
+         (mastodon (plstore-get plstore (concat "mastodon-" mastodon-instance-url))))
+    (cdr mastodon)))
 
 (defun mastodon-client ()
-  "Return variable `mastodon-client--client-details' plist.
+  "Return variable client secrets to use for the current `mastodon-instance-url'..
 
 Read plist from `mastodon-client--token-file' if variable is nil.
 Fetch and store plist if `mastodon-client--read' returns nil."
-  (or mastodon-client--client-details
-      (setq mastodon-client--client-details
+  (let ((client-details
+         (cdr (assoc mastodon-instance-url mastodon-client--client-details-alist))))
+    (unless client-details
+      (setq client-details
             (or (mastodon-client--read)
-                (mastodon-client--store)))))
+                (mastodon-client--store)))
+      (push (cons mastodon-instance-url client-details)
+            mastodon-client--client-details-alist))
+    client-details))
 
 (provide 'mastodon-client)
 ;;; mastodon-client.el ends here
+

lisp/mastodon-http.el

@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 2017 Johnson Denen
 ;; Author: Johnson Denen <[email protected]>
-;; Version: 0.7.1
+;; Version: 0.7.2
 ;; Package-Requires: ((emacs "24.4"))
 ;; Homepage: https://github.com/jdenen/mastodon.el
 
@@ -31,7 +31,6 @@
 
 (require 'json)
 (defvar mastodon-instance-url)
-(defvar mastodon-auth--token)
 (autoload 'mastodon-auth--access-token "mastodon-auth")
 
 (defvar mastodon-http--api-version "v1")
@@ -68,10 +67,10 @@ Open RESPONSE buffer if unsuccessful."
         (funcall success)
       (switch-to-buffer response))))
 
-(defun mastodon-http--post (url args headers)
+(defun mastodon-http--post (url args headers &optional unauthenticed-p)
   "POST synchronously to URL with ARGS and HEADERS.
 
-Authorization header is included by default."
+Authorization header is included by default unless UNAUTHENTICED-P is non-nil."
   (let ((url-request-method "POST")
         (url-request-data
          (when args
@@ -82,8 +81,10 @@ Authorization header is included by default."
                       args
                       "&")))
         (url-request-extra-headers
-         `(("Authorization" . ,(concat "Bearer " mastodon-auth--token))
-           ,headers)))
+	 (append
+	  (unless unauthenticed-p
+	    `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))))
+	  headers)))
     (with-temp-buffer
       (url-retrieve-synchronously url))))
 
@@ -107,6 +108,7 @@ Pass response buffer to CALLBACK function."
                   (decode-coding-string
                    (buffer-substring-no-properties (point) (point-max))
                    'utf-8)))
+             (kill-buffer)
              (json-read-from-string json-string)))))
     json-vector))
 

lisp/mastodon-inspect.el

@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 2017 Johnson Denen
 ;; Author: Johnson Denen <[email protected]>
-;; Version: 0.7.1
+;; Version: 0.7.2
 ;; Package-Requires: ((emacs "24.4"))
 ;; Homepage: https://github.com/jdenen/mastodon.el
 
@@ -55,7 +55,7 @@
   (interactive)
   (mastodon-inspect--dump-json-in-buffer
    (concat "*mastodon-inspect-toot-"
-           (int-to-string (mastodon-tl--property 'toot-id))
+           (mastodon-tl--as-string (mastodon-tl--property 'toot-id))
            "*")
   (mastodon-tl--property 'toot-json)))
 

lisp/mastodon-media.el

@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 2017 Johnson Denen
 ;; Author: Johnson Denen <[email protected]>
-;; Version: 0.7.1
+;; Version: 0.7.2
 ;; Homepage: https://github.com/jdenen/mastodon.el
 ;; Package-Requires: ((emacs "24.4"))
 
@@ -32,6 +32,8 @@
 ;; required by the server and client.
 
 ;;; Code:
+(defvar url-show-status)
+
 (defgroup mastodon-media nil
   "Inline Mastadon media."
   :prefix "mastodon-media-"
@@ -125,39 +127,42 @@ BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA
 fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=")
   "The PNG data for a generic 200x200 'broken image' view")
 
-(defun mastodon-media--process-image-response (status-plist marker image-options region-length)
+(defun mastodon-media--process-image-response
+    (status-plist marker image-options region-length)
   "Callback function processing the url retrieve response for URL.
 
 STATUS-PLIST is the usual plist of status events as per `url-retrieve'.
 IMAGE-OPTIONS are the precomputed options to apply to the image.
 MARKER is the marker to where the response should be visible.
 REGION-LENGTH is the length of the region that should be replaced with the image.
 "
-  (let ((url-buffer (current-buffer))
-        (is-error-response-p (eq :error (car status-plist))))
-    (unwind-protect
-        (let* ((data (unless is-error-response-p
-                       (goto-char (point-min))
-                       (search-forward "\n\n")
-                       (buffer-substring (point) (point-max))))
-               (image (when data
-                        (apply #'create-image data (when image-options 'imagemagick)
-                               t image-options))))
-          (switch-to-buffer (marker-buffer marker))
-          ;; Save narrowing in our buffer
-          (let ((inhibit-read-only t))
-            (save-restriction
-              (widen)
-              (put-text-property marker (+ marker region-length) 'media-state 'loaded)
-              (when image
-                ;; We only set the image to display if we could load
-                ;; it; we already have set a default image when we
-                ;; added the tag.
-                (put-text-property marker (+ marker region-length)
-                                   'display image))
-              ;; We are done with the marker; release it:
-              (set-marker marker nil)))
-          (kill-buffer url-buffer)))))
+  (when (marker-buffer marker) ; only if the buffer hasn't been kill in the meantime
+    (let ((url-buffer (current-buffer))
+          (is-error-response-p (eq :error (car status-plist))))
+      (unwind-protect
+          (let* ((data (unless is-error-response-p
+                         (goto-char (point-min))
+                         (search-forward "\n\n")
+                         (buffer-substring (point) (point-max))))
+                 (image (when data
+                          (apply #'create-image data (when image-options 'imagemagick)
+                                 t image-options))))
+            (with-current-buffer (marker-buffer marker)
+              ;; Save narrowing in our buffer
+              (let ((inhibit-read-only t))
+                (save-restriction
+                  (widen)
+                  (put-text-property marker
+                                     (+ marker region-length) 'media-state 'loaded)
+                  (when image
+                    ;; We only set the image to display if we could load
+                    ;; it; we already have set a default image when we
+                    ;; added the tag.
+                    (put-text-property marker (+ marker region-length)
+                                       'display image))
+                  ;; We are done with the marker; release it:
+                  (set-marker marker nil)))
+              (kill-buffer url-buffer)))))))
 
 (defun mastodon-media--load-image-from-url (url media-type start region-length)
   "Takes a URL and MEDIA-TYPE and load the image asynchronously.
@@ -171,7 +176,9 @@ MEDIA-TYPE is a symbol and either 'avatar or 'media-link."
                           ((eq media-type 'media-link)
                            `(:max-height ,mastodon-media--preview-max-height))))))
     (let ((buffer (current-buffer))
-          (marker (copy-marker start)))
+          (marker (copy-marker start))
+	  ;; Keep url.el from spamming us with messages about connecting to hosts:
+	  (url-show-status nil))
       (condition-case nil
           ;; catch any errors in url-retrieve so as to not abort
           ;; whatever called us
@@ -180,7 +187,10 @@ MEDIA-TYPE is a symbol and either 'avatar or 'media-link."
                         (list marker image-options region-length))
         (error (with-current-buffer buffer
                  ;; TODO: Consider adding retries
-                 (put-text-property marker (+ marker region-length) 'media-state 'loading-failed)
+                 (put-text-property marker
+                                    (+ marker region-length)
+                                    'media-state
+                                    'loading-failed)
                  :loading-failed))))))
 
 (defun mastodon-media--select-next-media-line ()
@@ -230,7 +240,8 @@ not been returned."
             (put-text-property start end 'media-state 'invalid-url)
           ;; proceed to load this image asynchronously
           (put-text-property start end 'media-state 'loading)
-          (mastodon-media--load-image-from-url image-url media-type start (- end start)))))))
+          (mastodon-media--load-image-from-url
+           image-url media-type start (- end start)))))))
 
 (defun mastodon-media--get-avatar-rendering (avatar-url)
   "Returns the string to be written that renders the avatar at AVATAR-URL."