diff options
author | marty hiatt <martianhiatus [a t] riseup [d o t] net> | 2023-10-05 10:57:31 +0200 |
---|---|---|
committer | marty hiatt <martianhiatus [a t] riseup [d o t] net> | 2023-10-05 10:57:31 +0200 |
commit | b8517fa6d65c9de75fef4a61742251811e9f2b96 (patch) | |
tree | b49241432f0922f989302af0731316d2dbd2e6f0 | |
parent | 5e12dc998527673cdb3350c6370570a256bfab5f (diff) | |
parent | 1964ee8ad6a0cd91a149a11925e1bcd94c83c072 (diff) |
Merge branch 'develop'
-rw-r--r-- | README.org | 6 | ||||
-rw-r--r-- | lisp/mastodon-http.el | 19 | ||||
-rw-r--r-- | lisp/mastodon-toot.el | 34 | ||||
-rw-r--r-- | lisp/mastodon-views.el | 67 | ||||
-rw-r--r-- | lisp/mastodon.el | 22 |
5 files changed, 94 insertions, 54 deletions
@@ -2,9 +2,11 @@ #+TEXINFO_DIR_TITLE: Mastodon: (mastodon). #+TEXINFO_DIR_DESC: Client for Mastodon on ActivityPub networks. -@@html: <a href="https://melpa.org/#/mastodon"><img alt="MELPA" src="https://melpa.org/packages/mastodon-badge.svg"/></a>@@ +@@html: <a href="https://elpa.nongnu.org/nongnu/mastodon.html"><img alt="ELPA" src="https://elpa.nongnu.org/nongnu/mastodon.svg"></a>@@ -@@html: <a href="https://ci.codeberg.org/martianh/mastodon.el"><img alt="Build Status" src="https://ci.codeberg.org/api/badges/martianh/mastodon.el/status.svg"></a>@@ +@@html: <a href="https://melpa.org/#/mastodon"><img alt="MELPA" src="https://melpa.org/packages/mastodon-badge.svg"></a>@@ + +# @@html: <a href="https://ci.codeberg.org/martianh/mastodon.el"><img alt="Build Status" src="https://ci.codeberg.org/api/badges/martianh/mastodon.el/status.svg"></a>@@ * README diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index ab621a2..cb4c323 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -127,17 +127,20 @@ 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 params headers unauthenticated-p) +(defun mastodon-http--post (url &optional params headers unauthenticated-p json) "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 params - (mastodon-http--build-params-string params))) - (url-request-extra-headers - (append url-request-extra-headers ; auth set in macro - (unless (assoc "Content-Type" headers) ; pleroma compat: - '(("Content-Type" . "application/x-www-form-urlencoded"))) - headers))) + (let* ((url-request-data + (when params + (if json + (json-encode params) + (fedi-http--build-params-string params)))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + (unless (assoc "Content-Type" headers) ; pleroma compat: + '(("Content-Type" . "application/x-www-form-urlencoded"))) + headers))) (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))) unauthenticated-p)) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a8c85d8..4c55412 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -758,12 +758,17 @@ to `emojify-user-emojis', and the emoji data is updated." (when (y-or-n-p "Looks like you haven't downloaded your instance's custom emoji yet. Download now? ") (mastodon-toot--download-custom-emoji))) - (setq emojify-user-emojis - (append (mastodon-toot--collect-custom-emoji) - emojify-user-emojis)) - ;; if already loaded, reload - (when (featurep 'emojify) - (emojify-set-emoji-data))) + ;; FIXME this test is awful, only works if we were last to mod the list: + (unless (equal (car (mastodon-toot--collect-custom-emoji)) + (car emojify-user-emojis)) + (setq emojify-user-emojis + (append (mastodon-toot--collect-custom-emoji) + emojify-user-emojis)) + ;; if already loaded, reload + (when (featurep 'emojify) + ;; we now only do this within the unless test above, as it is extremely + ;; slow and runs in `mastodon-mode-hook'. + (emojify-set-emoji-data)))) (defun mastodon-toot--remove-docs () "Get the body of a toot from the current compose buffer." @@ -1774,19 +1779,20 @@ Only text that is not one of these faces will be spell-checked." (let ((f (get-text-property (1- (point)) 'face))) (not (memq f faces)))))) -(add-hook 'mastodon-toot-mode-hook - (lambda () - (setq flyspell-generic-check-word-predicate - #'mastodon-toot-mode-flyspell-verify))) +(defun mastodon-toot-mode-hook-fun () + "Function for code to run in `mastodon-toot-mode-hook'." + ;; disable auto-fill-mode: + (auto-fill-mode -1) + ;; add flyspell predicate function: + (setq flyspell-generic-check-word-predicate + #'mastodon-toot-mode-flyspell-verify)) + +(add-hook 'mastodon-toot-mode-hook #'mastodon-toot-mode-hook-fun) ;;;###autoload (add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe) -;; disable auto-fill-mode: -(add-hook 'mastodon-toot-mode-hook - (lambda () - (auto-fill-mode -1))) (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index ad36664..f942729 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -716,7 +716,7 @@ If INSTANCE is given, use that." (string-remove-suffix (concat "/@" username) url)))) -(defun mastodon-views--view-instance-description (&optional user brief instance) +(defun mastodon-views--view-instance-description (&optional user brief instance misskey) "View the details of the instance the current post's author is on. USER means to show the instance details for the logged in user. BRIEF means to show fewer details. @@ -750,12 +750,32 @@ INSTANCE is an instance domain name." (username (if profile-note-p (alist-get 'username toot) ;; profile (alist-get 'username account))) - (instance (mastodon-views--get-instance-url url username instance)) - (response (mastodon-http--get-json - (concat instance "/api/v1/instance") nil nil :vector))) - (mastodon-views--instance-response-fun response brief instance))))) + (instance (mastodon-views--get-instance-url url username instance))) + (if misskey + (let* ((params `(("detail" . ,(or brief t)))) + (headers '(("Content-Type" . "application/json"))) + (url (concat instance "/api/meta")) + (response + (with-current-buffer (mastodon-http--post url params headers t :json) + (mastodon-http--process-response)))) + (mastodon-views--instance-response-fun response brief instance :misskey)) + (let ((response (mastodon-http--get-json + (concat instance "/api/v1/instance") nil nil :vector))) + ;; if non-misskey attempt errors, try misskey instance: + ;; akkoma i guess should not error here. + (if (eq 'error (caar response)) + (mastodon-views--instance-desc-misskey) + (mastodon-views--instance-response-fun response brief instance)))))))) + +(defun mastodon-views--instance-desc-misskey (&optional user brief instance) + "Show instance description for a misskey/firefish server. +USER, BRIEF, and INSTANCE are all for +`mastodon-views--view-instance-description', which see." + (interactive) + (mastodon-views--view-instance-description user brief instance :miskey)) -(defun mastodon-views--instance-response-fun (response brief instance) +(defun mastodon-views--instance-response-fun (response brief instance + &optional misskey) "Display instance description RESPONSE in a new buffer. BRIEF means to show fewer details. INSTANCE is the instance were are working with." @@ -764,21 +784,26 @@ INSTANCE is the instance were are working with." (buf (get-buffer-create (format "*mastodon-instance-%s*" domain)))) (with-mastodon-buffer buf #'special-mode :other-window - (when brief - (setq response - (list (assoc 'uri response) - (assoc 'title response) - (assoc 'short_description response) - (assoc 'email response) - (cons 'contact_account - (list - (assoc 'username - (assoc 'contact_account response)))) - (assoc 'rules response) - (assoc 'stats response)))) - (mastodon-views--print-json-keys response) - (mastodon-tl--set-buffer-spec (buffer-name buf) "instance" nil) - (goto-char (point-min)))))) + (if misskey + (let ((inihibit-read-only t)) + (insert (prin1-to-string response)) + (pp-buffer) + (goto-char (point-min))) + (when brief + (setq response + (list (assoc 'uri response) + (assoc 'title response) + (assoc 'short_description response) + (assoc 'email response) + (cons 'contact_account + (list + (assoc 'username + (assoc 'contact_account response)))) + (assoc 'rules response) + (assoc 'stats response)))) + (mastodon-views--print-json-keys response) + (mastodon-tl--set-buffer-spec (buffer-name buf) "instance" nil) + (goto-char (point-min))))))) (defun mastodon-views--format-key (el pad) "Format a key of element EL, a cons, with PAD padding." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 0dc6853..1ad1b5d 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -6,7 +6,7 @@ ;; Author: Johnson Denen <johnson.denen@gmail.com> ;; Marty Hiatt <martianhiatus@riseup.net> ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> -;; Version: 1.0.2 +;; Version: 1.0.3 ;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4")) ;; Homepage: https://codeberg.org/martianh/mastodon.el @@ -394,7 +394,8 @@ not, just browse the URL in the normal fashion." (string-match "^/u/[[:alpha:]]+$" query) (string-match "^/c/[[:alnum:]]+$" query) (string-match "^/post/[[:digit:]]+$" query) - (string-match "^/comment/[[:digit:]]+$" query))))) ; lemmy + (string-match "^/comment/[[:digit:]]+$" query) ; lemmy + (string-match "^/notes/[[:alnum:]]+$" query))))) ; misskey post (defun mastodon-live-buffers () "Return a list of open mastodon buffers. @@ -419,14 +420,17 @@ Calls `mastodon-tl--get-buffer-type', which see." buf-names))) (switch-to-buffer choice))) +(defun mastodon-mode-hook-fun () + "Function to add to `mastodon-mode-hook'." + (when (require 'emojify nil :noerror) + (emojify-mode t) + (when mastodon-toot--enable-custom-instance-emoji + (mastodon-toot--enable-custom-emoji)) + (when mastodon-tl--highlight-current-toot + (cursor-face-highlight-mode)))) ; 29.1 + ;;;###autoload -(add-hook 'mastodon-mode-hook (lambda () - (when (require 'emojify nil :noerror) - (emojify-mode t) - (when mastodon-toot--enable-custom-instance-emoji - (mastodon-toot--enable-custom-emoji)) - (when mastodon-tl--highlight-current-toot - (cursor-face-highlight-mode))))) ; 29.1 +(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun) ;;;###autoload (add-hook 'mastodon-mode-hook #'mastodon-profile--fetch-server-account-settings) |