From 8522172cac21c734c06b73c7447faaada0ef8899 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 29 Jul 2022 14:52:20 +0200 Subject: add single toot view - add detailed-p optional args to --byline, --insert-status --toot - for now, --byline just prints the app used if detailed-p - mastodon-tl--single-toot new fun to display --- lisp/mastodon-tl.el | 56 ++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 51 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7aef0a1..77c4198 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -512,7 +512,7 @@ E.g. this could return something like \"1 min ago\", \"yesterday\", etc. TIME-STAMP is assumed to be in the past." (car (mastodon-tl--relative-time-details timestamp current-time))) -(defun mastodon-tl--byline (toot author-byline action-byline) +(defun mastodon-tl--byline (toot author-byline action-byline &optional detailed-p) "Generate byline for TOOT. AUTHOR-BYLINE is a function for adding the author portion of @@ -568,6 +568,21 @@ By default it is `mastodon-tl--byline-boosted'" 'display (if mastodon-tl--enable-relative-timestamps (mastodon-tl--relative-time-description parsed-time) parsed-time)) + (when detailed-p + (let* ((app (alist-get 'application toot)) + (app-name (alist-get 'name app)) + (app-url (alist-get 'website app))) + (when app + (concat + (propertize " via " 'face 'default) + (propertize app-name + 'face 'mastodon-display-name-face + 'follow-link t + 'mouse-face 'highlight + 'mastodon-tab-stop 'shr-url + 'shr-url app-url + 'help-echo app-url + 'keymap mastodon-tl--shr-map-replacement))))) (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted @@ -859,7 +874,7 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (mastodon-tl--get-poll toot)) (mastodon-tl--media toot)))) -(defun mastodon-tl--insert-status (toot body author-byline action-byline &optional id parent-toot) +(defun mastodon-tl--insert-status (toot body author-byline action-byline &optional id parent-toot detailed-p) "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. @@ -880,7 +895,7 @@ PARENT-TOOT is the JSON of the toot responded to." (concat "\n" body " \n" - (mastodon-tl--byline toot author-byline action-byline)) + (mastodon-tl--byline toot author-byline action-byline detailed-p)) 'toot-id (or id ; for notifications (alist-get 'id toot)) 'base-toot-id (mastodon-tl--toot-id toot) @@ -1009,7 +1024,7 @@ in which case play first video or gif from current toot." (message "no moving image here?")) (message "no moving image here?")))) -(defun mastodon-tl--toot (toot) +(defun mastodon-tl--toot (toot &optional detailed-p) "Formats TOOT and insertes it into the buffer." (mastodon-tl--insert-status toot @@ -1018,7 +1033,10 @@ in which case play first video or gif from current toot." (mastodon-tl--spoiler toot) (mastodon-tl--content toot))) 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) + 'mastodon-tl--byline-boosted + nil + nil + detailed-p)) (defun mastodon-tl--timeline (toots) "Display each toot in TOOTS." @@ -1126,11 +1144,39 @@ webapp" (reblog (alist-get 'reblog json))) (if reblog (alist-get 'id reblog) id))) +(defun mastodon-tl--single-toot (&optional id) + "View toot at point in separate buffer. +ID is that of the toot to view." + (interactive) + (let* ((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)))) + (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'." (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))) -- cgit v1.2.3 From d8ceb814f872d723fe40a5d252b8ab7aaafecc0a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 29 Jul 2022 17:01:36 +0200 Subject: --thread: detailed-p for current toot in thread context and load single toot if no thread --- lisp/mastodon-tl.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 77c4198..8bb034c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1204,12 +1204,12 @@ ID is that of the toot to view." update-function (lambda (toot) (message "END of thread.")))) (let ((inhibit-read-only t)) - (mastodon-tl--timeline (vconcat - (alist-get 'ancestors context) - `(,toot) - (alist-get 'descendants context))))) + (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)) - (message "No Thread!")))) + (mastodon-tl--single-toot id)))) (defun mastodon-tl--create-filter () "Create a filter for a word. -- cgit v1.2.3 From c135e23457b437b2c28722b352ad6ce02cc766b2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 20 Aug 2022 17:38:59 +0200 Subject: comment unused toot var in bookmark fun --- lisp/mastodon-toot.el | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3081637..0da660e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -275,24 +275,24 @@ TYPE is a symbol, either 'favourite or 'boost." (defun mastodon-toot--bookmark-toot-toggle () "Bookmark or unbookmark toot at point." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--property 'base-toot-id)) - ;; (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (bookmarked-p (mastodon-tl--property 'bookmarked-p)) - (prompt (if bookmarked-p - (format "Toot already bookmarked. Remove? ") - (format "Bookmark this toot? "))) - (byline-region - (when id - (mastodon-tl--find-property-range 'byline (point)))) - (action (if bookmarked-p "unbookmark" "bookmark")) - (bookmark-str (if (fontp (char-displayable-p #10r128278)) - "🔖" - "K")) - (message (if bookmarked-p - "Bookmark removed!" - "Toot bookmarked!")) - (remove (when bookmarked-p t))) + (let* ( ;(toot (mastodon-tl--property 'toot-json)) + (id (mastodon-tl--property 'base-toot-id)) + ;; (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (bookmarked-p (mastodon-tl--property 'bookmarked-p)) + (prompt (if bookmarked-p + (format "Toot already bookmarked. Remove? ") + (format "Bookmark this toot? "))) + (byline-region + (when id + (mastodon-tl--find-property-range 'byline (point)))) + (action (if bookmarked-p "unbookmark" "bookmark")) + (bookmark-str (if (fontp (char-displayable-p #10r128278)) + "🔖" + "K")) + (message (if bookmarked-p + "Bookmark removed!" + "Toot bookmarked!")) + (remove (when bookmarked-p t))) (if byline-region (when (y-or-n-p prompt) (mastodon-toot--action -- cgit v1.2.3 From d914d579221504f85ae95b0dec7fd9abedbd30a7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 20 Aug 2022 17:39:37 +0200 Subject: flycheck and docstrings --- lisp/mastodon-tl.el | 24 +++++++++++++++++------- lisp/mastodon-toot.el | 11 ++++++----- 2 files changed, 23 insertions(+), 12 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f9b6bf6..4e2a8ba 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -519,7 +519,10 @@ AUTHOR-BYLINE is a function for adding the author portion of the byline that takes one variable. ACTION-BYLINE is a function for adding an action, such as boosting, favouriting and following to the byline. It also takes a single function. -By default it is `mastodon-tl--byline-boosted'" +By default it is `mastodon-tl--byline-boosted'. + +DETAILED-P means display more detailed info. For now +this just means displaying toot client." (let* ((created-time ;; bosts and faves in notifs view ;; (makes timestamps be for the original toot @@ -585,10 +588,10 @@ By default it is `mastodon-tl--byline-boosted'" '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 @@ -890,7 +893,8 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (mastodon-tl--get-poll toot)) (mastodon-tl--media toot)))) -(defun mastodon-tl--insert-status (toot body author-byline action-byline &optional id parent-toot detailed-p) +(defun mastodon-tl--insert-status (toot body author-byline action-byline + &optional id parent-toot detailed-p) "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. @@ -904,7 +908,10 @@ takes a single function. By default it is ID is that of the toot, which is attached as a property if it is a notification. If the status is a favourite or a boost, -PARENT-TOOT is the JSON of the toot responded to." +PARENT-TOOT is the JSON of the toot responded to. + +DETAILED-P means display more detailed info. For now +this just means displaying toot client." (let ((start-pos (point))) (insert (propertize @@ -1043,7 +1050,10 @@ in which case play first video or gif from current toot." (message "no moving image here?")))) (defun mastodon-tl--toot (toot &optional detailed-p) - "Formats TOOT and insertes it into the buffer." + "Formats TOOT and insertes it into the buffer. + +DETAILED-P means display more detailed info. For now +this just means displaying toot client." (mastodon-tl--insert-status toot (mastodon-tl--clean-tabs-and-nl diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 0da660e..0e26bb2 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -207,7 +207,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (defun mastodon-toot--action (action callback) "Take ACTION on toot at point, then execute CALLBACK. -Makes a POST request to the server." +Makes a POST request to the server. Used for favouriting, +boosting, or bookmarking toots." (let* ((id (mastodon-tl--property 'base-toot-id)) (url (mastodon-http--api (concat "statuses/" (mastodon-tl--as-string id) @@ -240,11 +241,11 @@ TYPE is a symbol, either 'favourite or 'boost." (if byline-region (cond ;; actually there's nothing wrong with faving/boosting own toots! ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json)) - ;;(error "You can't %s your own toots." action-string)) + ;;(error "You can't %s your own toots" action-string)) ((equal "reblog" toot-type) - (error "You can't %s boosts." action-string)) + (error "You can't %s boosts" action-string)) ((equal "favourite" toot-type) - (error "Your can't %s favourites." action-string)) + (error "Your can't %s favourites" action-string)) (t (mastodon-toot--action action @@ -402,7 +403,7 @@ NO-REDRAFT means delete toot only." toot-cw))))))))) (defun mastodon-toot-set-cw (&optional cw) - "Set content warning to CW if it is non-nil" + "Set content warning to CW if it is non-nil." (unless (equal cw "") (setq mastodon-toot--content-warning t) (setq mastodon-toot--content-warning-from-reply-or-redraft cw))) -- cgit v1.2.3 From ad6e15019541a38323733ee1576b8c8b39cc5f36 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 23 Aug 2022 10:35:54 +0200 Subject: implement tags company completion --- lisp/mastodon-search.el | 16 +++++++++++++--- lisp/mastodon-toot.el | 40 +++++++++++++++++++++++++++++++++++++++- 2 files changed, 52 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index cbb1fba..5756ae4 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -59,12 +59,22 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (mastodon-http--api "accounts/search")) - ;; (buffer (format "*mastodon-search-%s*" query)) (response (if (equal mastodon-toot--enable-completion-for-mentions "following") (mastodon-http--get-search-json url query "following=true") (mastodon-http--get-search-json url query)))) - (mapcar #'mastodon-search--get-user-info-@ - response))) + (mapcar #'mastodon-search--get-user-info-@ response))) + +;; functions for tags completion: + +(defun mastodon-search--search-tags-query (query) + "Return an alist containing tag strings plus their URLs. +QUERY is the string to search." + (interactive "sSearch for hashtag: ") + (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) + (type-param (concat "type=hashtags")) + (response (mastodon-http--get-search-json url query type-param)) + (tags (alist-get 'hashtags response))) + (mapcar #'mastodon-search--get-hashtag-info tags))) ;; functions for mastodon search diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 0e26bb2..b3de461 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -645,6 +645,43 @@ candidate ARG. IGNORED remains a mystery." (annotation (mastodon-toot--mentions-company-annotation arg)) (meta (mastodon-toot--mentions-company-meta arg)))) +(defun mastodon-toot--tags-company-candidates (prefix) + "Given a company PREFIX query, build a list of candidates. +The prefix can match against both user handles and display names." + (let ((prefix (substring prefix 1)) ;remove # for search + (res)) + (dolist (item (mastodon-search--search-tags-query prefix)) + (when (or (string-prefix-p prefix (substring (cadr item) 1) t) + (string-prefix-p prefix (car item) t)) + (push (mastodon-toot--tags-company-make-candidate item) res))) + res)) + +(defun mastodon-toot--tags-company-make-candidate (candidate) + "Construct a company completion CANDIDATE for display." + (let ((tag (concat "#" (car candidate))) + (url (cadr candidate))) + (propertize tag 'annot url 'meta url))) + +(defun mastodon-toot-tags (command &optional arg &rest ignored) + "A company completion backend for toot mentions. +COMMAND is either prefix, to fetch a prefix query, candidates, to +build a list of candidates with query ARG, annotation, to format +an annotation for candidate ARG, or meta, to format meta info for +candidate ARG. IGNORED remains a mystery." + (interactive (list 'interactive)) + (cl-case command + (interactive (company-begin-backend 'mastodon-toot-tags)) + (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode + (save-excursion + (forward-whitespace -1) + (forward-whitespace 1) + (looking-at "#"))) + ;; # + thing before point + (concat "#" (company-grab-symbol)))) + (candidates (mastodon-toot--tags-company-candidates arg)) + (annotation (mastodon-toot--mentions-company-annotation arg)) + (meta (mastodon-toot--mentions-company-meta arg)))) + (defun mastodon-toot--reply () "Reply to toot at `point'." (interactive) @@ -967,7 +1004,8 @@ REPLY-JSON is the full JSON of the toot being replied to." (when (require 'company nil :noerror) (when mastodon-toot--enable-completion-for-mentions (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot-mentions)) + (add-to-list 'company-backends 'mastodon-toot-mentions) + (add-to-list 'company-backends 'mastodon-toot-tags)) (company-mode-on))) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) -- cgit v1.2.3 From e620ef7cd4ff10a78334cd5e4293756e33f58f71 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 26 Aug 2022 18:01:48 +0200 Subject: completion customizes edit for handling tags completion --- lisp/mastodon-search.el | 2 +- lisp/mastodon-toot.el | 12 +++++++++--- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 5756ae4..89df311 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -59,7 +59,7 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (mastodon-http--api "accounts/search")) - (response (if (equal mastodon-toot--enable-completion-for-mentions "following") + (response (if (equal mastodon-toot--completion-style-for-mentions "following") (mastodon-http--get-search-json url query "following=true") (mastodon-http--get-search-json url query)))) (mapcar #'mastodon-search--get-user-info-@ response))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b3de461..b33350d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -103,13 +103,19 @@ followers-only), or \"direct\"." :group 'mastodon-toot :type 'integer) -(defcustom mastodon-toot--enable-completion-for-mentions - (if (require 'company nil :noerror) "following" "off") - "Whether to enable company completion for mentions. +(defcustom mastodon-toot--enable-completion + (if (require 'company nil :noerror) t nil) + "Whether to enable completion of mentions and hashtags. Used for completion in toot compose buffer. This is only used if company mode is installed." + :group 'mastodon-toot + :type 'boolean) + +(defcustom mastodon-toot--completion-style-for-mentions + (if (require 'company nil :noerror) "following" "off") + "The company completion style to use for mentions." :group 'mastodon-toot :type '(choice (const :tag "off" nil) -- cgit v1.2.3 From 7b09ea3957feeeb5c13663261893cca48fceb805 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 26 Aug 2022 18:02:22 +0200 Subject: refactor completion functions for two backends --- lisp/mastodon-toot.el | 137 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 82 insertions(+), 55 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b33350d..9abbb62 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -613,17 +613,6 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." "Format company completion CANDIDATE's annotation." (format " %s" (get-text-property 0 'annot candidate))) -(defun mastodon-toot--mentions-company-candidates (prefix) - "Given a company PREFIX query, build a list of candidates. -The prefix can match against both user handles and display names." - (let ((prefix (substring prefix 1)) ;remove @ for search - (res)) - (dolist (item (mastodon-search--search-accounts-query prefix)) - (when (or (string-prefix-p prefix (substring (cadr item) 1) t) - (string-prefix-p prefix (car item) t)) - (push (mastodon-toot--mentions-company-make-candidate item) res))) - res)) - (defun mastodon-toot--mentions-company-make-candidate (candidate) "Construct a company completion CANDIDATE for display." (let ((display-name (car candidate)) @@ -631,62 +620,100 @@ The prefix can match against both user handles and display names." (url (caddr candidate))) (propertize handle 'annot display-name 'meta url))) -(defun mastodon-toot-mentions (command &optional arg &rest ignored) - "A company completion backend for toot mentions. +(defun mastodon-toot--tags-company-make-candidate (candidate) + "Construct a company completion CANDIDATE for display." + (let ((tag (concat "#" (car candidate))) + (url (cadr candidate))) + (propertize tag 'annot url 'meta url))) + +(defun mastodon-toot--company-build-candidates (query list-fun make-fun) + "Build a list of completion candidates for a company backend. +QUERY is the search prefix, LIST-FUN builds a list of items to +match against, and MAKE-FUN builds the actual cadidate list item +for display by company." + (let ((query (substring query 1)) ; remove @ or # for search + (res)) + (dolist (item (funcall list-fun query)) + (when (or (string-prefix-p query (substring (cadr item) 1) t) + (string-prefix-p query (car item) t)) + (push (funcall make-fun item) res))) + res)) + +(defun mastodon-toot--mentions-company-candidates (query) + "Given a company QUERY, build a list of candidates. +The query can match both user handles and display names." + (mastodon-toot--company-build-candidates + query + 'mastodon-search--search-accounts-query + 'mastodon-toot--mentions-company-make-candidate)) + +(defun mastodon-toot--tags-company-candidates (query) + "Given a company QUERY, build a list of candidates. +The query is matched against a tag search on the server." + (mastodon-toot--company-build-candidates + query + 'mastodon-search--search-tags-query + 'mastodon-toot--tags-company-make-candidate)) + +(defun mastodon-toot--make-company-backend + (command backend-name str-prefix candidates-fun annot-fun meta-fun + &optional arg + &rest ignored) + "Make a company backend for `mastodon-toot-mode'. +COMMAND, ARG, IGNORED are all company backend args. COMMAND is either prefix, to fetch a prefix query, candidates, to build a list of candidates with query ARG, annotation, to format an annotation for candidate ARG, or meta, to format meta info for -candidate ARG. IGNORED remains a mystery." +candidate ARG. IGNORED remains a mystery. + +BACKEND-NAME is the backend's name, STR-PREFIX is used to search +for matches, CANDIDATES-FUN, ANNOT-FUN, and META-FUN are +functions called on ARG to generate formatted candidates, annotation, and +meta fields respectively." (interactive (list 'interactive)) (cl-case command - (interactive (company-begin-backend 'mastodon-toot-mentions)) + (interactive (company-begin-backend (quote backend-name))) (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode (save-excursion (forward-whitespace -1) (forward-whitespace 1) - (looking-at "@"))) - ;; @ + thing before point - (concat "@" (company-grab-symbol)))) - (candidates (mastodon-toot--mentions-company-candidates arg)) - (annotation (mastodon-toot--mentions-company-annotation arg)) - (meta (mastodon-toot--mentions-company-meta arg)))) - -(defun mastodon-toot--tags-company-candidates (prefix) - "Given a company PREFIX query, build a list of candidates. -The prefix can match against both user handles and display names." - (let ((prefix (substring prefix 1)) ;remove # for search - (res)) - (dolist (item (mastodon-search--search-tags-query prefix)) - (when (or (string-prefix-p prefix (substring (cadr item) 1) t) - (string-prefix-p prefix (car item) t)) - (push (mastodon-toot--tags-company-make-candidate item) res))) - res)) + (looking-at str-prefix))) + (concat str-prefix (company-grab-symbol)))) + (candidates (funcall candidates-fun arg)) + (annotation (funcall annot-fun arg)) + (meta (funcall meta-fun arg)))) -(defun mastodon-toot--tags-company-make-candidate (candidate) - "Construct a company completion CANDIDATE for display." - (let ((tag (concat "#" (car candidate))) - (url (cadr candidate))) - (propertize tag 'annot url 'meta url))) +(defun mastodon-toot-mentions (command &optional arg &rest ignored) + "A company completion backend for toot mentions. +COMMAND is either prefix, to fetch a prefix query, candidates, to +build a list of candidates with query ARG, annotation, to format +an annotation for candidate ARG, or meta, to format meta info for +candidate ARG. IGNORED remains a mystery." + (mastodon-toot--make-company-backend + command + 'mastodon-toot-mentions + "@" + 'mastodon-toot--mentions-company-candidates + 'mastodon-toot--mentions-company-annotation + 'mastodon-toot--mentions-company-meta + arg + ignored)) (defun mastodon-toot-tags (command &optional arg &rest ignored) - "A company completion backend for toot mentions. + "A company completion backend for toot tags. COMMAND is either prefix, to fetch a prefix query, candidates, to build a list of candidates with query ARG, annotation, to format an annotation for candidate ARG, or meta, to format meta info for candidate ARG. IGNORED remains a mystery." - (interactive (list 'interactive)) - (cl-case command - (interactive (company-begin-backend 'mastodon-toot-tags)) - (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode - (save-excursion - (forward-whitespace -1) - (forward-whitespace 1) - (looking-at "#"))) - ;; # + thing before point - (concat "#" (company-grab-symbol)))) - (candidates (mastodon-toot--tags-company-candidates arg)) - (annotation (mastodon-toot--mentions-company-annotation arg)) - (meta (mastodon-toot--mentions-company-meta arg)))) + (mastodon-toot--make-company-backend + command + 'mastodon-toot-tags + "#" + 'mastodon-toot--tags-company-candidates + 'mastodon-toot--mentions-company-annotation + 'mastodon-toot--mentions-company-meta + arg + ignored)) (defun mastodon-toot--reply () "Reply to toot at `point'." @@ -1008,11 +1035,11 @@ REPLY-JSON is the full JSON of the toot being replied to." (unless mastodon-toot--max-toot-chars (mastodon-toot--get-max-toot-chars)) (when (require 'company nil :noerror) - (when mastodon-toot--enable-completion-for-mentions + (when mastodon-toot--enable-completion (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot-mentions) - (add-to-list 'company-backends 'mastodon-toot-tags)) - (company-mode-on))) + (add-to-list 'company-backends 'mastodon-toot-mentions)) + (add-to-list 'company-backends 'mastodon-toot-tags)) + (company-mode-on)) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--refresh-attachments-display) -- cgit v1.2.3 From 8818971cb274f458d17ad8651480cf64a64d8b0e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 26 Aug 2022 18:27:44 +0200 Subject: readme re completion --- README.org | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/README.org b/README.org index 7503328..53bfc3c 100644 --- a/README.org +++ b/README.org @@ -176,7 +176,9 @@ Pops a new buffer/window in =mastodon-toot= minor mode. Enter the contents of your toot here. =C-c C-c= sends the toot. =C-c C-k= cancels. Both actions kill the buffer and window. -Autocompletion of mentions is provided by a mastodon company backend (requires =company-mode=). +Autocompletion of mentions and tags is provided by mastodon company backends +(requires =company-mode= and =mastodon-toot--enable-completion= must be set to =t=) +. Type =@= or =#= followed by two or more characters for candidates to appear. Replies preserve visibility status/content warnings, and include boosters by default. @@ -214,7 +216,7 @@ See =M-x customize-group RET mastodon= to view all customize options. - Compose options: - Default toot visibility, using =mastodon-toot--default-visibility= variable. Valid values are ="public"=, ="unlisted"=, ="private"=, or =direct=. - - Completions for mentions + - Completion for mentions and tags - Enable custom emoji *** live-updating timelines: =mastodon-async-mode= @@ -259,7 +261,7 @@ This version depends on the library =request= (for uploading attachments). You can install it from MELPA, or https://github.com/tkf/emacs-request. Optional dependencies: -- =company= for autocompletion of mentions when composing a toot +- =company= for autocompletion of mentions and tags when composing a toot - =emojify= for inserting and viewing emojis - =mpv= and =mpv.el= for viewing videos and gifs - =lingva.el= for translating toots -- cgit v1.2.3 From 3715823cce66553bc2d51f1431202d014439572b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 27 Aug 2022 08:44:55 +0200 Subject: autoloads, flycheck --- lisp/mastodon-notifications.el | 5 ++++- lisp/mastodon-profile.el | 4 ++-- lisp/mastodon-search.el | 2 +- lisp/mastodon.el | 3 ++- 4 files changed, 9 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 5de7354..89532c7 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -48,6 +48,7 @@ (autoload 'mastodon-tl--spoiler "mastodon-tl.el") (autoload 'mastodon-tl--toot-id "mastodon-tl.el") (autoload 'mastodon-http--get-params-async-json "mastodon-http.el") +(autoload 'mastodon-profile--view-follow-requests "mastodon-profile.el") (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) (defvar mastodon-tl--buffer-spec) @@ -219,7 +220,9 @@ Status notifications are given when (equal type 'boost)) status)))) -(defun mastodon-notifications--insert-status (toot body author-byline action-byline id &optional parent-toot) +(defun mastodon-notifications--insert-status (toot body + author-byline action-byline id + &optional parent-toot) "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index ae244d8..8ae5ace 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -65,7 +65,7 @@ (autoload 'mastodon-tl--goto-first-item "mastodon-tl") (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-search--insert-users-propertized "mastodon-search") - +(autoload 'mastodon-tl--get-endpoint "mastodon-tl.el") (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--update-point) @@ -78,7 +78,7 @@ (let ((map (make-sparse-keymap))) (define-key map (kbd "s") #'mastodon-profile--open-followers) (define-key map (kbd "g") #'mastodon-profile--open-following) - (define-key map (kbd "C-c C-c") #'mastodon-profile--account-view-cycle) + (define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle) map) "Keymap for `mastodon-profile-mode'.") diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 89df311..b9dcb18 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -40,7 +40,7 @@ (autoload 'mastodon-auth--access-token "mastodon-auth") (autoload 'mastodon-http--get-search-json "mastodon-http") (autoload 'mastodon-http--api "mastodon-http") - +(defvar mastodon-toot--completion-style-for-mentions) (defvar mastodon-instance-url) (defvar mastodon-tl--link-keymap) (defvar mastodon-http--timeout) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 49abe26..632f5c5 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -88,7 +88,8 @@ (autoload 'mastodon-profile--view-bookmarks "mastodon-profile") (autoload 'mastoton-tl--view-filters "mastodon-tl") ;; (autoload 'mastodon-toot--bookmark-toot-toggle "mastodon-toot") - +(autoload 'mastodon-tl--view-filters "mastodon-tl") +(autoload 'mastodon-tl--get-follow-suggestions "mastodon-tl") (when (require 'lingva nil :no-error) (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) -- cgit v1.2.3 From 5ed435bf9755db982fa70e6b47fcae1e3abc8a1d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 27 Aug 2022 09:44:14 +0200 Subject: update dependencies, request version consistency --- lisp/mastodon-profile.el | 2 +- lisp/mastodon.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 8ae5ace..c589f53 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt ;; Version: 0.10.0 -;; Package-Requires: ((emacs "27.1") (seq "1.0")) +;; Package-Requires: ((emacs "27.1") ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 632f5c5..4373ef2 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -5,7 +5,7 @@ ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt ;; Version: 0.10.0 -;; Package-Requires: ((emacs "27.1") (request "0.3.2") (seq "1.0")) +;; Package-Requires: ((emacs "27.1") (request "0.3.0")) ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. -- cgit v1.2.3 From c2a48ac4bd0b75adbb525600dca93ad6636177c3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 31 Jul 2022 22:54:30 +0200 Subject: bump version in boilerplate --- lisp/mastodon-async.el | 2 +- lisp/mastodon-auth.el | 2 +- lisp/mastodon-client.el | 2 +- lisp/mastodon-discover.el | 2 +- lisp/mastodon-http.el | 2 +- lisp/mastodon-inspect.el | 2 +- lisp/mastodon-media.el | 2 +- lisp/mastodon-notifications.el | 2 +- lisp/mastodon-profile.el | 4 ++-- lisp/mastodon-search.el | 2 +- lisp/mastodon-tl.el | 2 +- lisp/mastodon-toot.el | 2 +- lisp/mastodon.el | 6 +++--- 13 files changed, 16 insertions(+), 16 deletions(-) diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 86547a1..8a08416 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017 Alex J. Griffith ;; Author: Alex J. Griffith ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 2f333b7..02799bf 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -4,7 +4,7 @@ ;; Copyright (C) 2021 Abhiseck Paira ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index 4fc8db7..f1dcd4f 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -4,7 +4,7 @@ ;; Copyright (C) 2021 Abhiseck Paira ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index a63d500..20ed092 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index ec3b5e6..49b2375 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1") (request "0.3.0")) ;; Homepage: https://codeberg.org/martianh/mastodon.el diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index 15ee7ce..cbf6a8e 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index e5a1111..ace15b2 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 89532c7..0d11fb4 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index c589f53..4b541fd 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -3,8 +3,8 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 -;; Package-Requires: ((emacs "27.1") +;; Version: 1.0.0 +;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index b9dcb18..8d450e3 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Marty Hiatt ;; Author: Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 4e2a8ba..45e7282 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9abbb62..be3aaad 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 4373ef2..9400014 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -4,7 +4,7 @@ ;; Copyright (C) 2021 Abhiseck Paira ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.10.0 +;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1") (request "0.3.0")) ;; Homepage: https://codeberg.org/martianh/mastodon.el @@ -28,8 +28,8 @@ ;;; Commentary: ;; mastodon.el is an Emacs client for Mastodon , -;; the federated microblogging social network. It is very much a work-in-progress, but -;; it is a labor of love. +;; 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. ;;; Code: (require 'cl-lib) ; for `cl-some' call in mastodon -- cgit v1.2.3 From e5910a382c2f35d004643bb742a68e0189d0a83d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 27 Aug 2022 09:13:38 +0200 Subject: woodpecker CI add woodpecker cask install deps --- .travis.yml | 22 ---------------------- .woodpecker.yml | 7 +++++++ 2 files changed, 7 insertions(+), 22 deletions(-) delete mode 100644 .travis.yml create mode 100644 .woodpecker.yml diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 5f5796c..0000000 --- a/.travis.yml +++ /dev/null @@ -1,22 +0,0 @@ -language: emacs-lisp -sudo: false -before_install: - - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > x.sh && source ./x.sh - - evm install $EVM_EMACS --use --skip - - cask install -env: - - EVM_EMACS=emacs-24.5-travis - - EVM_EMACS=emacs-25.1-travis -script: - - emacs --version - - cask build - - cask clean-elc - - cask exec ert-runner -l test/ert-helper.el test/*-tests.el - - cask emacs --batch -Q -l package-lint.el -f package-lint-batch-and-exit lisp/*.el -notifications: - webhooks: - urls: - - "https://scalar.vector.im/api/neb/services/hooks/dHJhdmlzLWNpLyU0MGpvaG5zb24lM0FtYXRyaXgub3JnLyUyMVpSbGVnVEFCTHBTQmJ2c01tTiUzQW1hdHJpeC5vcmc" - on_success: always # always|never|change - on_failure: always - on_start: never diff --git a/.woodpecker.yml b/.woodpecker.yml new file mode 100644 index 0000000..26dc9d7 --- /dev/null +++ b/.woodpecker.yml @@ -0,0 +1,7 @@ +pipeline: + build: + image: silex/emacs:cask + commands: + - cask install + - cask emacs -batch -l test/ert-helper.el -l test/*-tests.el -f ert-run-tests-batch-and-exit + -- cgit v1.2.3 From 7fefb9d6c420e0498636b09465fbc1b811a33c12 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 27 Aug 2022 10:30:31 +0200 Subject: masto notifs tests filename correct --- test/mastodon-notifications-test.el | 217 ----------------------------------- test/mastodon-notifications-tests.el | 217 +++++++++++++++++++++++++++++++++++ 2 files changed, 217 insertions(+), 217 deletions(-) delete mode 100644 test/mastodon-notifications-test.el create mode 100644 test/mastodon-notifications-tests.el diff --git a/test/mastodon-notifications-test.el b/test/mastodon-notifications-test.el deleted file mode 100644 index 4804e10..0000000 --- a/test/mastodon-notifications-test.el +++ /dev/null @@ -1,217 +0,0 @@ -;;; mastodon-notifications-test.el --- Tests for mastodon-notifications.el -*- lexical-binding: nil -*- - -(require 'cl-lib) -(require 'cl-macs) -(require 'el-mock) - -(defconst mastodon-notifications--test-base-mentioned - '((id . "1234") - (type . "mention") - (created_at . "2018-03-06T04:27:21.288Z" ) - (account (id . 42) - (username . "acct42") - (acct . "acct42@example.space") - (display_name . "Account 42") - (locked . :json-false) - (created_at . "2017-04-01T00:00:00.000Z") - (followers_count . 99) - (following_count . 13) - (statuses_count . 101) - (note . "E")) - (status (id . 61208) - (created_at . "2017-04-24T19:01:02.000Z") - (in_reply_to_id) - (in_reply_to_account_id) - (sensitive . :json-false) - (spoiler_text . "") - (visibility . "public") - (account (id . 42) - (username . "acct42") - (acct . "acct42@example.space") - (display_name . "Account 42") - (locked . :json-false) - (created_at . "2017-04-01T00:00:00.000Z") - (followers_count . 99) - (following_count . 13) - (statuses_count . 101) - (note . "E")) - (media_attachments . []) - (mentions . []) - (tags . []) - (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") - (url . "https://example.space/users/acct42/updates/123456789") - (content . "

Just some text

") - (reblogs_count . 0) - (favourites_count . 0) - (reblog)))) - -(defconst mastodon-notifications--test-base-favourite - '((id . "1234") - (type . "favourite") - (created_at . "2018-03-06T04:27:21.288Z" ) - (account (id . 42) - (username . "acct42") - (acct . "acct42@example.space") - (display_name . "Account 42") - (locked . :json-false) - (created_at . "2017-04-01T00:00:00.000Z") - (followers_count . 99) - (following_count . 13) - (statuses_count . 101) - (note . "E")) - (status (id . 61208) - (created_at . "2017-04-24T19:01:02.000Z") - (in_reply_to_id) - (in_reply_to_account_id) - (sensitive . :json-false) - (spoiler_text . "") - (visibility . "public") - (account (id . 42) - (username . "acct42") - (acct . "acct42@example.space") - (display_name . "Account 42") - (locked . :json-false) - (created_at . "2017-04-01T00:00:00.000Z") - (followers_count . 99) - (following_count . 13) - (statuses_count . 101) - (note . "E")) - (media_attachments . []) - (mentions . []) - (tags . []) - (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") - (url . "https://example.space/users/acct42/updates/123456789") - (content . "

Just some text

") - (reblogs_count . 0) - (favourites_count . 0) - (reblog)))) - -(defconst mastodon-notifications--test-base-boosted - '((id . "1234") - (type . "reblog") - (created_at . "2018-03-06T04:27:21.288Z" ) - (account (id . 42) - (username . "acct42") - (acct . "acct42@example.space") - (display_name . "Account 42") - (locked . :json-false) - (created_at . "2017-04-01T00:00:00.000Z") - (followers_count . 99) - (following_count . 13) - (statuses_count . 101) - (note . "E")) - (status (id . 61208) - (created_at . "2017-04-24T19:01:02.000Z") - (in_reply_to_id) - (in_reply_to_account_id) - (sensitive . :json-false) - (spoiler_text . "") - (visibility . "public") - (account (id . 42) - (username . "acct42") - (acct . "acct42@example.space") - (display_name . "Account 42") - (locked . :json-false) - (created_at . "2017-04-01T00:00:00.000Z") - (followers_count . 99) - (following_count . 13) - (statuses_count . 101) - (note . "E")) - (media_attachments . []) - (mentions . []) - (tags . []) - (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") - (url . "https://example.space/users/acct42/updates/123456789") - (content . "

Just some text

") - (reblogs_count . 0) - (favourites_count . 0) - (reblog)))) - -(defconst mastodon-notifications--test-base-followed - '((id . "1234") - (type . "follow") - (created_at . "2018-03-06T04:27:21.288Z" ) - (account (id . 42) - (username . "acct42") - (acct . "acct42@example.space") - (display_name . "Account 42") - (locked . :json-false) - (created_at . "2017-04-01T00:00:00.000Z") - (followers_count . 99) - (following_count . 13) - (statuses_count . 101) - (note . "E")) - (status (id . 61208) - (created_at . "2017-04-24T19:01:02.000Z") - (in_reply_to_id) - (in_reply_to_account_id) - (sensitive . :json-false) - (spoiler_text . "") - (visibility . "public") - (account (id . 42) - (username . "acct42") - (acct . "acct42@example.space") - (display_name . "Account 42") - (locked . :json-false) - (created_at . "2017-04-01T00:00:00.000Z") - (followers_count . 99) - (following_count . 13) - (statuses_count . 101) - (note . "E")) - (media_attachments . []) - (mentions . []) - (tags . []) - (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") - (url . "https://example.space/users/acct42/updates/123456789") - (content . "

Just some text

") - (reblogs_count . 0) - (favourites_count . 0) - (reblog)))) - -(defconst mastodon-notifications--test-base-favourite - '((id . "1234") - (type . "mention") - (created_at . "2018-03-06T04:27:21.288Z" ) - (account (id . 42) - (username . "acct42") - (acct . "acct42@example.space") - (display_name . "Account 42") - (locked . :json-false) - (created_at . "2017-04-01T00:00:00.000Z") - (followers_count . 99) - (following_count . 13) - (statuses_count . 101) - (note . "E")))) - -(ert-deftest mastodon-notifications--notification-get () - "Ensure get request format for notifictions is accurate." - (let ((mastodon-instance-url "https://instance.url")) - (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications" )) - (mastodon-notifications--get)))) - -(defun mastodon-notifications--test-type (fun sample) - "Test notification draw functions. - -FUN is the notificiation function to be called and SAMPLE is the -notification to be tested." - (let ((mastodon-tl--show-avatars-p nil) - (timestamp (cdr (assoc 'created_at sample)))) - (with-temp-buffer (funcall fun sample) - (buffer-substring-no-properties (point-min) (point-max))))) - -(ert-deftest mastodon-notifications--test-byline-concat () - "Ensure proper suffix is appended to action." - (should (and - (string= " Mentioned you" - (mastodon-notifications--byline-concat "Mentioned")) - (string= " Followed you" - (mastodon-notifications--byline-concat "Followed")) - (string= " Favourited your status from" - (mastodon-notifications--byline-concat "Favourited")) - (string= " Boosted your status from" - (mastodon-notifications--byline-concat "Boosted")) - (string= " Posted a post" - (mastodon-notifications--byline-concat "Posted"))))) - - diff --git a/test/mastodon-notifications-tests.el b/test/mastodon-notifications-tests.el new file mode 100644 index 0000000..f5cc4c5 --- /dev/null +++ b/test/mastodon-notifications-tests.el @@ -0,0 +1,217 @@ +;;; mastodon-notifications-tests.el --- Tests for mastodon-notifications.el -*- lexical-binding: nil -*- + +(require 'cl-lib) +(require 'cl-macs) +(require 'el-mock) + +(defconst mastodon-notifications--test-base-mentioned + '((id . "1234") + (type . "mention") + (created_at . "2018-03-06T04:27:21.288Z" ) + (account (id . 42) + (username . "acct42") + (acct . "acct42@example.space") + (display_name . "Account 42") + (locked . :json-false) + (created_at . "2017-04-01T00:00:00.000Z") + (followers_count . 99) + (following_count . 13) + (statuses_count . 101) + (note . "E")) + (status (id . 61208) + (created_at . "2017-04-24T19:01:02.000Z") + (in_reply_to_id) + (in_reply_to_account_id) + (sensitive . :json-false) + (spoiler_text . "") + (visibility . "public") + (account (id . 42) + (username . "acct42") + (acct . "acct42@example.space") + (display_name . "Account 42") + (locked . :json-false) + (created_at . "2017-04-01T00:00:00.000Z") + (followers_count . 99) + (following_count . 13) + (statuses_count . 101) + (note . "E")) + (media_attachments . []) + (mentions . []) + (tags . []) + (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") + (url . "https://example.space/users/acct42/updates/123456789") + (content . "

Just some text

") + (reblogs_count . 0) + (favourites_count . 0) + (reblog)))) + +(defconst mastodon-notifications--test-base-favourite + '((id . "1234") + (type . "favourite") + (created_at . "2018-03-06T04:27:21.288Z" ) + (account (id . 42) + (username . "acct42") + (acct . "acct42@example.space") + (display_name . "Account 42") + (locked . :json-false) + (created_at . "2017-04-01T00:00:00.000Z") + (followers_count . 99) + (following_count . 13) + (statuses_count . 101) + (note . "E")) + (status (id . 61208) + (created_at . "2017-04-24T19:01:02.000Z") + (in_reply_to_id) + (in_reply_to_account_id) + (sensitive . :json-false) + (spoiler_text . "") + (visibility . "public") + (account (id . 42) + (username . "acct42") + (acct . "acct42@example.space") + (display_name . "Account 42") + (locked . :json-false) + (created_at . "2017-04-01T00:00:00.000Z") + (followers_count . 99) + (following_count . 13) + (statuses_count . 101) + (note . "E")) + (media_attachments . []) + (mentions . []) + (tags . []) + (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") + (url . "https://example.space/users/acct42/updates/123456789") + (content . "

Just some text

") + (reblogs_count . 0) + (favourites_count . 0) + (reblog)))) + +(defconst mastodon-notifications--test-base-boosted + '((id . "1234") + (type . "reblog") + (created_at . "2018-03-06T04:27:21.288Z" ) + (account (id . 42) + (username . "acct42") + (acct . "acct42@example.space") + (display_name . "Account 42") + (locked . :json-false) + (created_at . "2017-04-01T00:00:00.000Z") + (followers_count . 99) + (following_count . 13) + (statuses_count . 101) + (note . "E")) + (status (id . 61208) + (created_at . "2017-04-24T19:01:02.000Z") + (in_reply_to_id) + (in_reply_to_account_id) + (sensitive . :json-false) + (spoiler_text . "") + (visibility . "public") + (account (id . 42) + (username . "acct42") + (acct . "acct42@example.space") + (display_name . "Account 42") + (locked . :json-false) + (created_at . "2017-04-01T00:00:00.000Z") + (followers_count . 99) + (following_count . 13) + (statuses_count . 101) + (note . "E")) + (media_attachments . []) + (mentions . []) + (tags . []) + (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") + (url . "https://example.space/users/acct42/updates/123456789") + (content . "

Just some text

") + (reblogs_count . 0) + (favourites_count . 0) + (reblog)))) + +(defconst mastodon-notifications--test-base-followed + '((id . "1234") + (type . "follow") + (created_at . "2018-03-06T04:27:21.288Z" ) + (account (id . 42) + (username . "acct42") + (acct . "acct42@example.space") + (display_name . "Account 42") + (locked . :json-false) + (created_at . "2017-04-01T00:00:00.000Z") + (followers_count . 99) + (following_count . 13) + (statuses_count . 101) + (note . "E")) + (status (id . 61208) + (created_at . "2017-04-24T19:01:02.000Z") + (in_reply_to_id) + (in_reply_to_account_id) + (sensitive . :json-false) + (spoiler_text . "") + (visibility . "public") + (account (id . 42) + (username . "acct42") + (acct . "acct42@example.space") + (display_name . "Account 42") + (locked . :json-false) + (created_at . "2017-04-01T00:00:00.000Z") + (followers_count . 99) + (following_count . 13) + (statuses_count . 101) + (note . "E")) + (media_attachments . []) + (mentions . []) + (tags . []) + (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") + (url . "https://example.space/users/acct42/updates/123456789") + (content . "

Just some text

") + (reblogs_count . 0) + (favourites_count . 0) + (reblog)))) + +(defconst mastodon-notifications--test-base-favourite + '((id . "1234") + (type . "mention") + (created_at . "2018-03-06T04:27:21.288Z" ) + (account (id . 42) + (username . "acct42") + (acct . "acct42@example.space") + (display_name . "Account 42") + (locked . :json-false) + (created_at . "2017-04-01T00:00:00.000Z") + (followers_count . 99) + (following_count . 13) + (statuses_count . 101) + (note . "E")))) + +(ert-deftest mastodon-notifications--notification-get () + "Ensure get request format for notifictions is accurate." + (let ((mastodon-instance-url "https://instance.url")) + (with-mock + (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications" )) + (mastodon-notifications--get)))) + +(defun mastodon-notifications--test-type (fun sample) + "Test notification draw functions. + +FUN is the notificiation function to be called and SAMPLE is the +notification to be tested." + (let ((mastodon-tl--show-avatars-p nil) + (timestamp (cdr (assoc 'created_at sample)))) + (with-temp-buffer (funcall fun sample) + (buffer-substring-no-properties (point-min) (point-max))))) + +(ert-deftest mastodon-notifications--test-byline-concat () + "Ensure proper suffix is appended to action." + (should (and + (string= " Mentioned you" + (mastodon-notifications--byline-concat "Mentioned")) + (string= " Followed you" + (mastodon-notifications--byline-concat "Followed")) + (string= " Favourited your status from" + (mastodon-notifications--byline-concat "Favourited")) + (string= " Boosted your status from" + (mastodon-notifications--byline-concat "Boosted")) + (string= " Posted a post" + (mastodon-notifications--byline-concat "Posted"))))) + + -- cgit v1.2.3 From ed8353064120e8941c617884c361c2cf1898e674 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 27 Aug 2022 10:30:47 +0200 Subject: update ert-helper to load all tests files --- .woodpecker.yml | 2 +- test/ert-helper.el | 8 ++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/.woodpecker.yml b/.woodpecker.yml index 26dc9d7..53952ec 100644 --- a/.woodpecker.yml +++ b/.woodpecker.yml @@ -3,5 +3,5 @@ pipeline: image: silex/emacs:cask commands: - cask install - - cask emacs -batch -l test/ert-helper.el -l test/*-tests.el -f ert-run-tests-batch-and-exit + - cask emacs -batch -l test/ert-helper.el -f ert-run-tests-batch-and-exit diff --git a/test/ert-helper.el b/test/ert-helper.el index f65649f..140425b 100644 --- a/test/ert-helper.el +++ b/test/ert-helper.el @@ -13,3 +13,11 @@ (load-file "lisp/mastodon-search.el") (load-file "lisp/mastodon-tl.el") (load-file "lisp/mastodon-toot.el") + +;; load tests in bulk to avoid using deprecated `cask exec' +(let ((tests (cl-remove-if-not (lambda (x) + (string-suffix-p "-tests.el" x)) + (directory-files "test/." t directory-files-no-dot-files-regexp)))) + (mapc #'load-file tests)) + + -- cgit v1.2.3