diff options
| -rw-r--r-- | README.org | 8 | ||||
| -rw-r--r-- | lisp/mastodon-media.el | 35 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 9 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 21 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 113 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 257 | ||||
| -rw-r--r-- | test/mastodon-profile-tests.el | 5 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 16 | 
8 files changed, 245 insertions, 219 deletions
| @@ -189,9 +189,7 @@ 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 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. +Autocompletion of mentions and tags is provided by =completion-at-point-functions= (capf) backends. =mastodon-toot--enable-completion= is enabled by default. If you want to enable =company-mode= in the toot compose buffer, set =mastodon-toot--use-company-for-completion= to =t=. (=mastodon.el= used to run its own native company backends, but these have been removed in favour of capfs.)  Replies preserve visibility status/content warnings, and include boosters by default. @@ -214,6 +212,7 @@ You can download and use your instance's custom emoji  | =C-c !=   | Remove all attachments           |  | =C-c C-e= | Add emoji (if =emojify= installed) |  | =C-c C-p= | Create a poll                    | +| =C-c C-l= | Set toot language                |  |---------+----------------------------------|  **** draft toots @@ -264,7 +263,7 @@ See =M-x customize-group RET mastodon= to view all customize options.     - Enable image caching  - Compose options: -   - Completion for mentions and tags +   - Completion style for mentions and tags     - Enable custom emoji     - Display toot being replied to @@ -312,7 +311,6 @@ Hard dependencies (should all install with =mastodon.el=):  - =ts= for poll relative expiry times  Optional dependencies: -- =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 diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 9715a6c..c783130 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -35,6 +35,8 @@  ;;; Code:  (require 'url-cache) +(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl") +  (defvar url-show-status)  (defvar mastodon-tl--shr-image-map-replacement) @@ -306,34 +308,23 @@ Replace them with the referenced image."                                   t image-options))       " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type caption) +(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url +                                                           type caption)    "Return the string to be written that renders the image at MEDIA-URL.  FULL-REMOTE-URL is used for `shr-browse-image'.  TYPE is the attachment's type field on the server.  CAPTION is the image caption if provided."    (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview") -        (help-echo (if caption -                       (concat help-echo-base -                               "\n\"" -                               caption "\"") -                     help-echo-base))) +         (help-echo (if caption +                        (concat help-echo-base +                                "\n\"" +                                caption "\"") +                      help-echo-base)))      (concat -     (propertize "[img]" -                 'media-url media-url -                 'media-state 'needs-loading -                 'media-type 'media-link -                 'mastodon-media-type type -                 'display (create-image mastodon-media--generic-broken-image-data nil t) -                 'mouse-face 'highlight -                 'mastodon-tab-stop 'image ; for do-link-action-at-point -                 'image-url full-remote-url ; for shr-browse-image -                 'keymap mastodon-tl--shr-image-map-replacement -                 'help-echo (if (or (string= type "image") -                                    (string= type nil) -                                    (string= type "unknown")) ;handle borked images -                                help-echo -                              (concat help-echo "\nC-RET: play " type " with mpv"))) -                 " "))) +     (mastodon-tl--propertize-img-str-or-url +      "[img]" media-url full-remote-url type help-echo +      (create-image mastodon-media--generic-broken-image-data nil t)) +     " ")))  (provide 'mastodon-media)  ;;; mastodon-media.el ends here diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 8cea4d7..d6b2b94 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -617,15 +617,18 @@ NO-REBLOGS means do not display boosts in statuses."                   " [locked]")               "")             "\n ------------\n" -           (mastodon-tl--render-text note account) +           ;; profile note:             ;; account here to enable tab-stops in profile note +           (mastodon-tl--render-text note account) +           ;; meta fields:             (if fields                 (concat "\n"                         (mastodon-tl--set-face                          (mastodon-profile--fields-insert fields) -                        'success) -                       "\n") +                        'success))               "") +           "\n" +           ;; Joined date:             (propertize              (mastodon-profile--format-joined-date-string joined)              'face 'success) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index b037faa..65c5aba 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -47,7 +47,13 @@  (defvar mastodon-toot--enable-completion-for-mentions)  (defvar mastodon-tl--buffer-spec) -;; functions for company completion of mentions in mastodon-toot +;; functions for completion of mentions in mastodon-toot + +(defun mastodon-search--get-user-info-@-capf (account) +  "Get user handle, display name and account URL from ACCOUNT." +  (list (concat "@" (cdr (assoc 'acct account))) +        (cdr (assoc 'url account)) +        (cdr (assoc 'display_name account))))  (defun mastodon-search--get-user-info-@ (account)    "Get user handle, display name and account URL from ACCOUNT." @@ -55,15 +61,17 @@          (concat "@" (cdr (assoc 'acct account)))          (cdr (assoc 'url account)))) -(defun mastodon-search--search-accounts-query (query) +(defun mastodon-search--search-accounts-query (query &optional capf)    "Prompt for a search QUERY and return accounts synchronously.  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--completion-style-for-mentions "following") -                       (mastodon-http--get-json url `(("q" . ,query) ("following" . "true"))) -                     (mastodon-http--get-json url `(("q" . ,query)))))) -    (mapcar #'mastodon-search--get-user-info-@ response))) +                       (mastodon-http--get-json url `(("q" . ,query) ("following" . "true")) :silent) +                     (mastodon-http--get-json url `(("q" . ,query)) :silent)))) +    (if capf +        (mapcar #'mastodon-search--get-user-info-@-capf response) +      (mapcar #'mastodon-search--get-user-info-@ response))))  ;; functions for tags completion: @@ -72,10 +80,9 @@ Returns a nested list containing user handle, display name, and URL."  QUERY is the string to search."    (interactive "sSearch for hashtag: ")    (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) -         ;; (type-param '(("type" . "hashtags")))           (params `(("q" . ,query)                     ("type" . "hashtags"))) -         (response (mastodon-http--get-json url params)) +         (response (mastodon-http--get-json url params :silent))           (tags (alist-get 'hashtags response)))      (mapcar #'mastodon-search--get-hashtag-info tags))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 46ec8fe..1a726c4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -107,6 +107,13 @@ By default fixed width fonts are used."    :type '(boolean :tag "Enable using proportional rather than fixed \  width fonts when rendering HTML text")) +(defcustom mastodon-tl--display-caption-not-url-when-no-media t +  "Display an image's caption rather than URL. +Only has an effect when `mastodon-tl--display-media-p' is set to +nil." +  :group 'mastodon-tl +  :type 'boolean) +  (defvar-local mastodon-tl--buffer-spec nil    "A unique identifier and functions for each Mastodon buffer.") @@ -600,9 +607,6 @@ this just means displaying toot client."           (faved (equal 't (mastodon-tl--field 'favourited toot)))           (boosted (equal 't (mastodon-tl--field 'reblogged toot)))           (bookmarked (equal 't (mastodon-tl--field 'bookmarked toot))) -         (bookmark-str (if (fontp (char-displayable-p #10r128278)) -                           "🔖" -                         "K"))           (visibility (mastodon-tl--field 'visibility toot))           (account (alist-get 'account toot))           (avatar-url (alist-get 'avatar account)) @@ -617,12 +621,14 @@ this just means displaying toot client."       ;; displayed for an already boosted/favourited toot or as the result of       ;; the toot having just been favourited/boosted.       (concat (when boosted -               (mastodon-tl--format-faved-or-boosted-byline "B")) +               (mastodon-tl--format-faved-or-boosted-byline +                (mastodon-tl--return-boost-char)))               (when faved                 (mastodon-tl--format-faved-or-boosted-byline                  (mastodon-tl--return-fave-char)))               (when bookmarked -               (mastodon-tl--format-faved-or-boosted-byline bookmark-str))) +               (mastodon-tl--format-faved-or-boosted-byline +                (mastodon-tl--return-bookmark-char))))       ;; we remove avatars from the byline also, so that they also do not mess       ;; with `mastodon-tl--goto-next-toot':       (when (and mastodon-tl--show-avatars @@ -667,10 +673,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)))))         (if edited-time             (concat              (if (fontp (char-displayable-p #10r128274)) @@ -685,7 +691,7 @@ this just means displaying toot client."                            (mastodon-tl--relative-time-description edited-parsed)                          edited-parsed)))           "") -       (propertize "\n  ------------\n  " 'face 'default)) +       (propertize "\n  ------------\n" 'face 'default))        'favourited-p faved        'boosted-p    boosted        'bookmarked-p bookmarked @@ -694,6 +700,14 @@ this just means displaying toot client."                        (mastodon-toot--get-toot-edits (alist-get 'id toot)))        'byline       t)))) +(defun mastodon-tl--return-boost-char () +  "" +  (cond +   ((fontp (char-displayable-p #10r128257)) +    "🔁") +   (t +    "B"))) +  (defun mastodon-tl--return-fave-char ()    ""    (cond @@ -704,6 +718,12 @@ this just means displaying toot client."     (t      "F"))) +(defun mastodon-tl--return-bookmark-char () +  "" +  (if (fontp (char-displayable-p #10r128278)) +      "🔖" +    "K")) +  (defun mastodon-tl--format-edit-timestamp (timestamp)    "Convert edit TIMESTAMP into a descriptive string."    (let ((parsed (ts-human-duration @@ -1018,27 +1038,70 @@ message is a link which unhides/hides the main body."  (defun mastodon-tl--media (toot)    "Retrieve a media attachment link for TOOT if one exists." -  (let* ((media-attachements (mastodon-tl--field 'media_attachments toot)) -         (media-string (mapconcat -                        (lambda (media-attachement) -                          (let ((preview-url -                                 (alist-get 'preview_url media-attachement)) -                                (remote-url -                                 (or (alist-get 'remote_url media-attachement) -                                     ;; fallback b/c notifications don't have remote_url -                                     (alist-get 'url media-attachement))) -                                (type (alist-get 'type media-attachement)) -                                (caption (alist-get 'description media-attachement))) -                            (if mastodon-tl--display-media-p -                                (mastodon-media--get-media-link-rendering -                                 preview-url remote-url type caption) ; 2nd arg for shr-browse-url -                              (concat "Media::" preview-url "\n")))) -                        media-attachements ""))) +  (let* ((media-attachments (mastodon-tl--field 'media_attachments toot)) +         (media-string (mapconcat #'mastodon-tl--media-attachment +                                  media-attachments "")))      (if (not (and mastodon-tl--display-media-p                    (string-empty-p media-string)))          (concat "\n" media-string)        ""))) +(defun mastodon-tl--media-attachment (media-attachment) +  "Return a propertized string for MEDIA-ATTACHMENT." +  (let* ((preview-url +          (alist-get 'preview_url media-attachment)) +         (remote-url +          (or (alist-get 'remote_url media-attachment) +              ;; fallback b/c notifications don't have remote_url +              (alist-get 'url media-attachment))) +         (type (alist-get 'type media-attachment)) +         (caption (alist-get 'description media-attachment)) +         (display-str +          (if (and mastodon-tl--display-caption-not-url-when-no-media +                   caption) +              (concat "Media:: " caption) +            (concat "Media:: " preview-url)))) +    (if mastodon-tl--display-media-p +        ;; return placeholder [img]: +        (mastodon-media--get-media-link-rendering +         preview-url remote-url type caption) ; 2nd arg for shr-browse-url +      ;; return URL/caption: +      (concat +       (mastodon-tl--propertize-img-str-or-url +        (concat "Media:: " preview-url) ;; string +        preview-url remote-url type caption +        display-str ;; display +        ;; FIXME: shr-link underlining is awful for captions with +        ;; newlines, as the underlining runs to the edge of the +        ;; frame even if the text doesn' +        'shr-link) +       "\n")))) + +(defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url type +                                                   help-echo &optional display face) +  "Propertize an media placeholder string \"[img]\" or media URL. + +STR is the string to propertize, MEDIA-URL is the preview link, +FULL-REMOTE-URL is the link to the full resolution image on the +server, TYPE is the media type. +HELP-ECHO, DISPLAY, and FACE are the text properties to add." +  (propertize str +              'media-url media-url +              'media-state (when (string= str "[img]") 'needs-loading) +              'media-type 'media-link +              'mastodon-media-type type +              'display display +              'face face +              'mouse-face 'highlight +              'mastodon-tab-stop 'image ; for do-link-action-at-point +              'image-url full-remote-url ; for shr-browse-image +              'keymap mastodon-tl--shr-image-map-replacement +              'help-echo (if (or (string= type "image") +                                 (string= type nil) +                                 (string= type "unknown")) ;handle borked images +                             help-echo +                           (concat help-echo "\nC-RET: play " type " with mpv")))) +  (defun mastodon-tl--content (toot)    "Retrieve text content from TOOT.  Runs `mastodon-tl--render-text' and fetches poll or media." diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 0e21b0e..59a3813 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -41,12 +41,6 @@  (require 'cl-lib)  (require 'persist) -(when (require 'company nil :noerror) -  (declare-function company-mode-on "company") -  (declare-function company-begin-backend "company") -  (declare-function company-grab-symbol "company") -  (defvar company-backends)) -  (require 'mastodon-iso)  (defvar mastodon-instance-url) @@ -106,18 +100,24 @@    :group 'mastodon-toot    :type 'integer) -(defcustom mastodon-toot--enable-completion -  (if (require 'company nil :noerror) t nil) +(defcustom mastodon-toot--enable-completion t    "Whether to enable completion of mentions and hashtags. +Used for completion in toot compose buffer." +  :group 'mastodon-toot +  :type 'boolean) -Used for completion in toot compose buffer. +(defcustom mastodon-toot--use-company-for-completion nil +  "Whether to enable company for completion. -This is only used if company mode is installed." +When non-nil, `company-mode' is enabled in the toot compose +buffer, and mastodon completion backends are added to +`company-capf'. + +You need to install company yourself to use this."    :group 'mastodon-toot    :type 'boolean) -(defcustom mastodon-toot--completion-style-for-mentions -  (if (require 'company nil :noerror) "following" "off") +(defcustom mastodon-toot--completion-style-for-mentions "all"    "The company completion style to use for mentions."    :group 'mastodon-toot    :type '(choice @@ -188,6 +188,9 @@ Takes its form from `window-configuration-to-register'.")  (defvar mastodon-toot--max-toot-chars nil    "The maximum allowed characters count for a single toot.") +(defvar-local mastodon-toot-completions nil +  "The data of completion candidates for the current completion at point.") +  (defvar mastodon-toot-current-toot-text nil    "The text of the toot being composed.") @@ -205,6 +208,13 @@ send.")     "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @     "\\b")) +(defvar mastodon-toot-tag-regex +  (concat +   ;; preceding space or bol [boundary doesn't work with #] +   "\\([\n\t ]\\|^\\)" +   "\\(?2:#[1-9a-zA-Z_]+\\)" ; tag +   "\\b")) ; boundary +  (defvar mastodon-toot-mode-map    (let ((map (make-sparse-keymap)))      (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -335,7 +345,7 @@ TYPE is a symbol, either 'favourite or 'boost."                                        (list 'favourited-p (not faved))))                 (mastodon-toot--action-success                  (if boost-p -                    "B" +                    (mastodon-tl--return-boost-char)                    (mastodon-tl--return-fave-char))                  byline-region remove))               (message (format "%s #%s" (if boost-p msg action) id)))))) @@ -818,129 +828,75 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."                 (reverse (append mentions nil))                 ""))) -(defun mastodon-toot--mentions-company-meta (candidate) -  "Format company completion CANDIDATE's meta field." -  (format " %s" -          (get-text-property 0 'meta candidate))) - -(defun mastodon-toot--mentions-company-annotation (candidate) -  "Format company completion CANDIDATE's annotation." -  (format " %s" (get-text-property 0 'annot candidate))) - -(defun mastodon-toot--mentions-company-make-candidate (candidate) -  "Construct a company completion CANDIDATE for display." -  (let ((display-name (car candidate)) -        (handle (cadr candidate)) -        (url (caddr candidate))) -    (propertize handle 'annot display-name 'meta url))) - -(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. - -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)) -  (let ((handle-before -         ;; hack to handle @handles@with.domains, as "@" is a word/symbol boundary -         (if (string= str-prefix "@") -             (save-match-data -               (save-excursion -                 (re-search-backward mastodon-toot-handle-regex nil :no-error) -                 (if (match-string-no-properties 2) -                     ;; match full handle inc. domain (see the regex for subexp 2) -                     (buffer-substring-no-properties (match-beginning 2) (match-end 2)) -                   "")))))) -    (cl-case command -      (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 str-prefix))) -                (if (and (string= str-prefix "@") -                         (> (length handle-before) 1)) ; more than just @ -                    (concat str-prefix (substring-no-properties handle-before 1)) ;handle -                  (concat str-prefix (company-grab-symbol))))) ; tag -      (candidates (funcall candidates-fun arg)) -      (annotation (funcall annot-fun arg)) -      (meta (funcall meta-fun arg))))) - -(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 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." -  (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--get-bounds (regex) +  "Get bounds of tag or handle before point." +  ;; needed because # and @ are not part of any existing thing at point +  (save-match-data +    (save-excursion +      ;; match full handle inc. domain, or tag including # +      ;; (see the regexes for subexp 2) +      (when (re-search-backward regex nil :no-error) +        (cons (match-beginning 2) +              (match-end 2)))))) + +(defun mastodon-toot--mentions-capf () +  "Build a mentions completion backend for `completion-at-point-functions'." +  (let* ((bounds +          (mastodon-toot--get-bounds mastodon-toot-handle-regex)) +         (start (car bounds)) +         (end (cdr bounds))) +    (when bounds +      (list start +            end +            ;; only search when necessary: +            (completion-table-dynamic +             (lambda (_) +               ;; TODO: do we really need to set a local var here +               ;; just for the annotation-function? +               (setq mastodon-toot-completions +                     (mastodon-search--search-accounts-query +                      (buffer-substring-no-properties start end) +                      :capf)))) +            :exclusive 'no +            :annotation-function +            (lambda (candidate) +              (concat " " +                      (mastodon-toot--mentions-annotation-fun candidate))))))) + +(defun mastodon-toot--tags-capf () +  "Build a tags completion backend for `completion-at-point-functions'." +  (let* ((bounds +          (mastodon-toot--get-bounds mastodon-toot-tag-regex)) +         (start (car bounds)) +         (end (cdr bounds))) +    (when bounds +      (list start +            end +            ;; only search when necessary: +            (completion-table-dynamic +             (lambda (_) +               (setq mastodon-toot-completions +                     (let ((tags (mastodon-search--search-tags-query +                                  (buffer-substring-no-properties start end)))) +                       (mapcar (lambda (x) +                                 (list (concat "#" (car x)) +                                       (cdr x))) +                               tags))))) +            :exclusive 'no +            :annotation-function +            (lambda (candidate) +              (concat " " +                      (mastodon-toot--tags-annotation-fun candidate))))))) + +(defun mastodon-toot--mentions-annotation-fun (candidate) +  "Given a handle completion CANDIDATE, return its annotation string, a username." +  (caddr (assoc candidate mastodon-toot-completions))) + +(defun mastodon-toot--tags-annotation-fun (candidate) +  "Given a tag string CANDIDATE, return an annotation, the tag's URL." +  ;; FIXME check the list returned here? should be cadr +  ;;or make it an alist and use cdr +  (caadr (assoc candidate mastodon-toot-completions)))  (defun mastodon-toot--reply ()    "Reply to toot at `point'. @@ -1419,13 +1375,12 @@ Added to `after-change-functions'."        ;; 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 "\\([\n\t ]\\|^\\)\\(?2:#[1-9a-zA-Z_]+\\)\\b" +      (mastodon-toot--propertize-item mastodon-toot-tag-regex                                        'success                                        (cdr header-region)) -      (mastodon-toot--propertize-item -       mastodon-toot-handle-regex -       'mastodon-display-name-face -       (cdr header-region))))) +      (mastodon-toot--propertize-item mastodon-toot-handle-regex +                                      'mastodon-display-name-face +                                      (cdr header-region)))))  (defun mastodon-toot--propertize-item (regex face start)    "Propertize item matching REGEX with FACE starting from START." @@ -1473,14 +1428,22 @@ a draft into the buffer."        ;; no need to fetch from `mastodon-profile-account-settings' as        ;; `mastodon-toot--max-toot-chars' is set when we set it        (mastodon-toot--get-max-toot-chars)) -    ;; set up company backends: -    (when (require 'company nil :noerror) -      (when mastodon-toot--enable-completion +    ;; set up completion: +    (when mastodon-toot--enable-completion +      (set ; (setq-local +       (make-local-variable 'completion-at-point-functions) +       (add-to-list +        'completion-at-point-functions +        #'mastodon-toot--mentions-capf)) +      (add-to-list +       'completion-at-point-functions +       #'mastodon-toot--tags-capf) +      ;; company +      (when mastodon-toot--use-company-for-completion          (set (make-local-variable 'company-backends) -             (add-to-list 'company-backends 'mastodon-toot-mentions)) -        (add-to-list 'company-backends 'mastodon-toot-tags)) -      (unless (bound-and-true-p corfu-mode) ; don't clash w corfu mode +             (add-to-list 'company-backends 'company-capf))          (company-mode-on))) +    ;; after-change:      (make-local-variable 'after-change-functions)      (push #'mastodon-toot--update-status-fields after-change-functions)      (mastodon-toot--refresh-attachments-display) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 7478aaf..1ce9514 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -237,7 +237,7 @@ content generation in the function under test."      (if (version< emacs-version "27.1")          (mock (image-type-available-p 'imagemagick) => t)        (mock (image-transforms-p) => t)) -    (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses") +    (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses" nil)            =>            gargon-statuses-json)      (mock (mastodon-profile--get-statuses-pinned *) @@ -271,7 +271,8 @@ content generation in the function under test."           "@Gargron\n"           " ------------\n"           "<p>Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.</p>\n" -         "_ Patreon __ :: <a href=\"https://www.patreon.com/mastodon\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://www.</span><span class=\"\">patreon.com/mastodon</span><span class=\"invisible\"></span></a>_ Homepage _ :: <a href=\"https://zeonfederated.com\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">zeonfederated.com</span><span class=\"invisible\"></span></a>\n" +         "_ Patreon __ :: <a href=\"https://www.patreon.com/mastodon\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://www.</span><span class=\"\">patreon.com/mastodon</span><span class=\"invisible\"></span></a>_ Homepage _ :: <a href=\"https://zeonfederated.com\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">zeonfederated.com</span><span class=\"invisible\"></span></a>" +         "\n"           "Joined March 2016"           "\n\n"           " ------------\n" diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 0ac5caf..a80c3ee 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -317,7 +317,7 @@ Strict-Transport-Security: max-age=31536000  			              byline)  			             "Account 42 (@acct42@example.space) 2999-99-99 00:11:22    ------------ -  ")) +"))          (should (eq (get-text-property handle-location 'mastodon-tab-stop byline)                      'user-handle))          (should (string= (get-text-property handle-location 'mastodon-handle byline) @@ -340,7 +340,7 @@ Strict-Transport-Security: max-age=31536000                                               'mastodon-tl--byline-boosted))                         "Account 42 (@acct42@example.space) 2999-99-99 00:11:22    ------------ -  "))))) +")))))  (ert-deftest mastodon-tl--byline-boosted ()    "Should format the boosted toot correctly." @@ -357,7 +357,7 @@ Strict-Transport-Security: max-age=31536000                                               'mastodon-tl--byline-boosted))                         "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22    ------------ -  "))))) +")))))  (ert-deftest mastodon-tl--byline-favorited ()    "Should format the favourited toot correctly." @@ -374,7 +374,7 @@ Strict-Transport-Security: max-age=31536000                                               'mastodon-tl--byline-boosted))                         "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22    ------------ -  "))))) +")))))  (ert-deftest mastodon-tl--byline-boosted/favorited () @@ -392,7 +392,7 @@ Strict-Transport-Security: max-age=31536000                                               'mastodon-tl--byline-boosted))                         "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22    ------------ -  "))))) +")))))  (ert-deftest mastodon-tl--byline-reblogged ()    "Should format the reblogged toot correctly." @@ -418,7 +418,7 @@ Strict-Transport-Security: max-age=31536000  			             "Account 42 (@acct42@example.space)    Boosted Account 43 (@acct43@example.space) original time    ------------ -  ")) +"))          (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline)                      'user-handle))          (should (equal (get-text-property handle1-location 'help-echo byline) @@ -451,7 +451,7 @@ Strict-Transport-Security: max-age=31536000                         "Account 42 (@acct42@example.space)    Boosted Account 43 (@acct43@example.space) original time    ------------ -  "))))) +")))))  (ert-deftest mastodon-tl--byline-reblogged-boosted/favorited ()    "Should format the reblogged toot that was also boosted & favoritedcorrectly." @@ -475,7 +475,7 @@ Strict-Transport-Security: max-age=31536000                         "(B) (F) Account 42 (@acct42@example.space)    Boosted Account 43 (@acct43@example.space) original time    ------------ -  "))))) +")))))  (ert-deftest mastodon-tl--byline-timestamp-has-relative-display ()    "Should display the timestamp with a relative time." | 
