diff options
author | marty hiatt <martianhiatus [a t] riseup [d o t] net> | 2022-11-09 09:02:39 +0100 |
---|---|---|
committer | marty hiatt <martianhiatus [a t] riseup [d o t] net> | 2022-11-09 09:02:39 +0100 |
commit | 2ce371fce2a818af52217bcba8b30b326dfffa2c (patch) | |
tree | a3b49952eb860a2410df50d46850130a9d36b588 | |
parent | 40cf1038e386cfe62cfcc81234794b3a13102176 (diff) | |
parent | dc05ae39d5044d79d8288b36a71f90dba4b85724 (diff) |
Merge branch 'develop' into headers
-rw-r--r-- | Cask | 1 | ||||
-rw-r--r-- | README.org | 11 | ||||
-rw-r--r-- | lisp/mastodon-tl.el | 83 | ||||
-rw-r--r-- | lisp/mastodon-toot.el | 57 | ||||
-rw-r--r-- | lisp/mastodon.el | 8 |
5 files changed, 118 insertions, 42 deletions
@@ -7,6 +7,7 @@ (depends-on "request" "0.3.0") (depends-on "seq") (depends-on "persist") +(depends-on "ts") (development (depends-on "ert-runner") @@ -202,7 +202,8 @@ You can download and use your instance's custom emoji | =C-c C-n= | Add sensitive media/nsfw flag | | =C-c C-a= | Upload attachment(s) | | =C-c != | Remove all attachments | -| =C-c C-e= | add emoji (if =emojify= installed) | +| =C-c C-e= | Add emoji (if =emojify= installed) | +| =C-c C-p= | Create a poll | |---------+----------------------------------| **** draft toots @@ -285,8 +286,10 @@ to your translator function as its text argument. Here's what ** Dependencies -This version depends on the library =request= (for uploading attachments). You -can install it from MELPA, or https://github.com/tkf/emacs-request. +Hard dependencies (should all install with =mastodon.el=): +- =request= (for uploading attachments), https://github.com/tkf/emacs-request +- =persist= for storing some settings across sessions +- =ts= for poll relative expiry times Optional dependencies: - =company= for autocompletion of mentions and tags when composing a toot @@ -296,7 +299,7 @@ Optional dependencies: ** Contributing -PRs, issues, and feature requests are very welcome! +PRs, issues, feature requests, and general feedback are very welcome! *** Features diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a9c8b39..a3ef2ae 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -5,7 +5,7 @@ ;; Marty Hiatt <martianhiatus@riseup.net> ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> ;; Version: 1.0.0 -;; Package-Requires: ((emacs "27.1")) +;; Package-Requires: ((emacs "27.1") (ts "0.3")) ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. @@ -32,6 +32,7 @@ ;;; Code: (require 'shr) +(require 'ts) (require 'thingatpt) ; for word-at-point (require 'time-date) (require 'cl-lib) @@ -371,12 +372,12 @@ Used on initializing a timeline or thread." (propertize (concat "@" handle) 'face 'mastodon-handle-face 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle + 'mastodon-tab-stop 'user-handle 'account account - 'shr-url profile-url - 'keymap mastodon-tl--link-keymap + 'shr-url profile-url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" handle) - 'help-echo (concat "Browse user profile of @" handle)) + 'help-echo (concat "Browse user profile of @" handle)) ")"))) (defun mastodon-tl--format-faves-count (toot) @@ -592,10 +593,10 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) + 'keymap mastodon-tl--shr-map-replacement))))) (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted @@ -949,6 +950,7 @@ this just means displaying toot client." (expiry (mastodon-tl--field 'expires_at poll)) (expired-p (if (eq (mastodon-tl--field 'expired poll) :json-false) nil t)) (multi (mastodon-tl--field 'multiple poll)) + (vote-count (mastodon-tl--field 'voters_count poll)) (options (mastodon-tl--field 'options poll)) (option-titles (mapcar (lambda (x) (alist-get 'title x)) @@ -971,19 +973,31 @@ this just means displaying toot client." (length (alist-get 'title option)))) ?\ ) - (if (eq (alist-get 'votes_count option) nil) - "" - (format "[%s votes]" (alist-get 'votes_count option)))))) + ;; TODO: disambiguate no votes from hidden votes + (format "[%s votes]" (or (alist-get 'votes_count option) + "0"))))) options "\n") - (unless expired-p - (propertize (format "Expires: %s" expiry) - 'face 'font-lock-comment-face)) - (when expired-p - (propertize "Poll expired." - 'face 'font-lock-comment-face)) + "\n" + (propertize (format "%s people | " vote-count) + 'face 'font-lock-comment-face) + (let ((str (if expired-p + "Poll expired." + (mastodon-tl--format-poll-expiry expiry)))) + (propertize str 'face 'font-lock-comment-face)) "\n"))) +(defun mastodon-tl--format-poll-expiry (timestamp) + "Convert poll expiry TIMESTAMP into a descriptive string." + (let ((parsed (ts-human-duration + (ts-diff (ts-parse timestamp) (ts-now))))) + (cond ((> (plist-get parsed :days) 0) + (format "%s days, %s hours left" (plist-get parsed :days) (plist-get parsed :hours))) + ((> (plist-get parsed :hours) 0) + (format "%s hours, %s minutes left" (plist-get parsed :hours) (plist-get parsed :minutes))) + ((> (plist-get parsed :minutes) 0) + (format "%s minutes left" (plist-get parsed :minutes)))))) + (defun mastodon-tl--poll-vote (option) "If there is a poll at point, prompt user for OPTION to vote on it." (interactive @@ -1519,7 +1533,7 @@ IND is the optional indentation level to print at." (when ind (indent-to ind)) (insert (mastodon-tl--format-key el pad) " " - (mastodon-tl--newline-if-long el) + (mastodon-tl--newline-if-long (cdr el)) ;; only send strings straight to --render-text ;; this makes hyperlinks work: (if (not (stringp val)) @@ -1529,25 +1543,36 @@ IND is the optional indentation level to print at." "\n")))))))) (defun mastodon-tl--print-instance-rules-or-fields (alist) - "Print ALIST of instance rules or contact account fields." - (let ((key (if (alist-get 'id alist) 'id 'name)) - (value (if (alist-get 'id alist) 'text 'value))) + "Print ALIST of instance rules or contact account or emoji fields." + (let ((key (cond ((alist-get 'id alist) + 'id) + ((alist-get 'name alist) + 'name) + ((alist-get 'shortcode alist) + 'shortcode))) + (value (cond ((alist-get 'id alist) + 'text) + ((alist-get 'value alist) + 'value) + ((alist-get 'url alist) + 'url)))) (indent-to 4) (insert (format "%-5s: " (propertize (alist-get key alist) 'face '(:underline t))) - (mastodon-tl--newline-if-long (assoc value alist)) - (format "%s" (mastodon-tl--render-text - (alist-get value alist))) - "\n"))) + (mastodon-tl--newline-if-long (alist-get value alist)) + (format "%s" (mastodon-tl--render-text + (alist-get value alist))) + "\n"))) (defun mastodon-tl--newline-if-long (el) "Return a newline string if the cdr of EL is over 50 characters long." - (if (and (sequencep (cdr el)) - (< 50 (length (cdr el)))) - "\n" - "")) + (let ((rend (if (stringp el) (mastodon-tl--render-text el) el))) + (if (and (sequencep rend) + (< 50 (length rend))) + "\n" + ""))) (defun mastodon-tl--follow-user (user-handle &optional notify) "Query for USER-HANDLE from current status and follow that user. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 25446ef..70aaf14 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -603,7 +603,7 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--build-poll-params () "Return an alist of parameters for POSTing a poll status." (append - (mastodon-toot--make-poll-params + (mastodon-toot--make-poll-options-params (plist-get mastodon-toot-poll :options)) `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi)))) @@ -941,7 +941,7 @@ which is used to attach it to a toot when posting." mastodon-toot--media-attachments)) (list "None"))) -(defun mastodon-toot--make-poll-params (options) +(defun mastodon-toot--make-poll-options-params (options) "Return an parameter query alist from poll OPTIONS." (let ((key "poll[options][]")) (cl-loop for o in options @@ -951,8 +951,8 @@ which is used to attach it to a toot when posting." "Prompt for new poll options and return as a list." (interactive) ;; re length, API docs show a poll 9 options. - (let* ((length (read-number "Number of poll options [2-9]: " 2)) - (multiple-p (y-or-n-p "Multiple choice poll? ")) + (let* ((length (read-number "Number of options [2-4]: " 2)) + (multiple-p (y-or-n-p "Multiple choice? ")) (options (mastodon-toot--read-poll-options length)) (hide-totals (y-or-n-p "Hide votes until poll ends? ")) (expiry (mastodon-toot--get-poll-expiry))) @@ -968,8 +968,25 @@ which is used to attach it to a toot when posting." (defun mastodon-toot--get-poll-expiry () "Prompt for a poll expiry time." ;; API requires this in seconds - ;; TODO: offer sane poll expiry options - (read-string "poll ends in [seconds, min 5 mins]: ")) + (let* ((options (mastodon-toot--poll-expiry-options-alist)) + (response (completing-read "poll ends in [or enter seconds]: " + options nil 'confirm))) + (or (alist-get response options nil nil #'equal) + (if (< (string-to-number response) 600) + "600" ;; min 5 mins + response)))) + +(defun mastodon-toot--poll-expiry-options-alist () + "Return an alist of seconds options." + `(("5 minutes" . ,(number-to-string (* 60 5))) + ("30 minutes" . ,(number-to-string (* 60 30))) + ("1 hour" . ,(number-to-string (* 60 60))) + ("6 hours" . ,(number-to-string (* 60 60 6))) + ("1 day" . ,(number-to-string (* 60 60 24))) + ("3 days" . ,(number-to-string (* 60 60 24 3))) + ("7 days" . ,(number-to-string (* 60 60 24 7))) + ("14 days" . ,(number-to-string (* 60 60 24 14))) + ("30 days" . ,(number-to-string (* 60 60 24 30))))) ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings @@ -1187,6 +1204,33 @@ Added to `after-change-functions' in new toot buffers." (setq mastodon-toot-draft-toots-list nil) (message "All drafts deleted!")) +(defun mastodon-toot--propertize-tags-and-handles (&rest _args) + "Propertize tags and handles in toot compose buffer. +Added to `after-change-functions'." + (when (mastodon-toot-compose-buffer-p) + (let ((header-region + (mastodon-tl--find-property-range 'toot-post-header + (point-min)))) + ;; cull any prev props: + ;; stops all text after a handle or mention being propertized: + (set-text-properties (cdr header-region) (point-max) nil) + ;; TODO: confirm allowed hashtag/handle characters: + (mastodon-toot--propertize-item "#[1-9a-zA-Z_]+" + 'success + (cdr header-region)) + (mastodon-toot--propertize-item "@[1-9a-zA-Z._-]+" + 'mastodon-display-name-face + (cdr header-region))))) + +(defun mastodon-toot--propertize-item (regex face start) + "Propertize item matching REGEX with FACE starting from START." + (save-excursion + (goto-char start) + (cl-loop while (search-forward-regexp regex nil :noerror) + do (add-text-properties (match-beginning 0) + (match-end 0) + `(face ,face))))) + (defun mastodon-toot-compose-buffer-p () "Return t if compose buffer is current." (equal (buffer-name (current-buffer)) "*new toot*")) @@ -1236,6 +1280,7 @@ a draft into the buffer." ;; draft toot text saving: (setq mastodon-toot-current-toot-text nil) (push #'mastodon-toot--save-toot-text after-change-functions) + (push #'mastodon-toot--propertize-tags-and-handles after-change-functions) (when initial-text (insert initial-text)))) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index a5ba9e4..3b0a7d0 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -1,11 +1,13 @@ -;;; mastodon.el --- Client for Mastodon -*- lexical-binding: t -*- +;;; mastodon.el --- Client for Mastodon, a federated social network -*- lexical-binding: t -*- ;; Copyright (C) 2017-2019 Johnson Denen +;; Copyright (C) 2020-2022 Marty Hiatt ;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org> ;; Author: Johnson Denen <johnson.denen@gmail.com> +;; Marty Hiatt <martianhiatus@riseup.net> ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> ;; Version: 1.0.0 -;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4")) +;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4") (ts "0.3")) ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. @@ -29,7 +31,7 @@ ;; mastodon.el is an Emacs client for Mastodon <https://github.com/tootsuite/mastodon>, ;; the federated microblogging social network. It also works with Pleroma instances. -;; see the readme file at https://codeberg.org/martianh/mastodon.el for set up and usage details. +;; See the readme file at https://codeberg.org/martianh/mastodon.el for set up and usage details. ;;; Code: (require 'cl-lib) ; for `cl-some' call in mastodon |