diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-auth.el | 31 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 6 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 4 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 36 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 48 | ||||
| -rw-r--r-- | lisp/mastodon-views.el | 5 | ||||
| -rw-r--r-- | lisp/mastodon.el | 28 |
7 files changed, 94 insertions, 64 deletions
diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 279377b..9f9d128 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -105,30 +105,25 @@ code. Copy this code and paste it in the minibuffer prompt." (defun mastodon-auth--show-notice (notice buffer-name &optional ask) "Display NOTICE to user. -NOTICE is displayed in vertical split occupying 50% of total +By default NOTICE is displayed in vertical split occupying 50% of total width. The buffer name of the buffer being displayed in the window is BUFFER-NAME. When optional argument ASK is given which should be a string, use ASK as the minibuffer prompt. Return whatever user types in response to the prompt. When ASK is absent return nil." - (let ((buffer (get-buffer-create buffer-name)) - (inhibit-read-only t) - ask-value window) - (set-buffer buffer) - (erase-buffer) - (insert notice) - (fill-region (point-min) (point-max)) - (read-only-mode) - (setq window (select-window - (split-window (frame-root-window) nil 'left) - t)) - (switch-to-buffer buffer t) - (when ask - (setq ask-value (read-string ask)) - (kill-buffer buffer) - (delete-window window)) - ask-value)) + (if ask + (read-string ask) + (let ((buffer (get-buffer-create buffer-name)) + (inhibit-read-only t)) + (set-buffer buffer) + (erase-buffer) + (insert notice) + (fill-region (point-min) (point-max)) + (read-only-mode) + (prog1 nil + (pop-to-buffer buffer '(display-buffer-in-side-window + (side . left) (window-width . 0.5))))))) (defun mastodon-auth--request-authorization-code () "Ask authorization code and return it." diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index a357672..aef8975 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -179,8 +179,9 @@ PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message. NO-HEADERS means don't collect http response headers. VECTOR means return json arrays as vectors." - (with-current-buffer (mastodon-http--get url params silent) - (mastodon-http--process-response no-headers vector))) + (let ((buf (mastodon-http--get url params silent))) + (with-current-buffer buf + (mastodon-http--process-response no-headers vector)))) (defun mastodon-http--get-json (url &optional params silent vector) "Return only JSON data from URL request. @@ -240,7 +241,6 @@ Callback to `mastodon-http--get-response-async', usually (defun mastodon-http--process-headers () "Return an alist of http response headers." - (switch-to-buffer (current-buffer)) (goto-char (point-min)) (let* ((head-str (buffer-substring-no-properties (point-min) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index fc90cf7..5929f1c 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -745,7 +745,9 @@ IMG-TYPE is the JSON key from the account data." "Show the profile of the currently signed in user." (interactive) (message "Loading your profile...") - (mastodon-profile--show-user (mastodon-auth--get-account-name))) + (let ((account (mastodon-profile--account-from-id + (mastodon-auth--get-account-id)))) + (mastodon-profile--make-author-buffer account))) (defun mastodon-profile--format-user (tootv) "Convert TOOTV into author-bylines and insert. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 3d8e8dd..856325e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -292,7 +292,7 @@ It is active where point is placed by `mastodon-tl--goto-next-item.'") "Evaluate BODY in a new or existing buffer called BUFFER. MODE-FUN is called to set the major mode. OTHER-WINDOW means call `switch-to-buffer-other-window' rather -than `switch-to-buffer'." +than `pop-to-buffer'." (declare (debug t) (indent 3)) `(with-current-buffer (get-buffer-create ,buffer) @@ -301,7 +301,7 @@ than `switch-to-buffer'." (funcall ,mode-fun) (if ,other-window (switch-to-buffer-other-window ,buffer) - (switch-to-buffer ,buffer)) + (pop-to-buffer ,buffer '(display-buffer-same-window))) ,@body))) (defmacro mastodon-tl--do-if-item (&rest body) @@ -368,21 +368,22 @@ text, i.e. hidden spoiler text." "Search for item with function FIND-POS. If search returns nil, execute REFRESH function. Optionally start from POS." - (let* ((npos (or ; toot/user items have byline: - (funcall find-pos - (or pos (point)) - ;; 'item-type ; breaks nav to last item in a view? - 'byline - (current-buffer))))) + (let* ((npos ; toot/user items have byline: + (funcall find-pos + (or pos (point)) + ;; FIXME: we need to fix item-type? + ;; 'item-type ; breaks nav to last item in a view? + 'byline + (current-buffer)))) (if npos - (if (not (or - ;; (get-text-property npos 'item-id) ; toots, users, not tags - (get-text-property npos 'item-type))) ; generic + (if (not + ;; (get-text-property npos 'item-id) ; toots, users, not tags + (get-text-property npos 'item-type)) ; generic (mastodon-tl--goto-item-pos find-pos refresh npos) (goto-char npos) ;; force display of help-echo on moving to a toot byline: (mastodon-tl--message-help-echo)) - ;; FIXME: this doesn't really work, as the funcall doesn't return if we + ;; FIXME: this doesn't work, as the funcall doesn't return if we ;; run into an endless refresh loop (condition-case nil (funcall refresh) @@ -2149,7 +2150,10 @@ ARGS is an alist of any parameters to send with the request." (mapconcat #'cdr args " "))) ((and (eq notify nil) (eq reblogs nil)) - (message "User %s (@%s) %sed!" name user-handle action)))))))) + (if (and (equal action "follow") + (eq t (alist-get 'requested json))) + (message "Follow requested for user %s (@%s)!" name user-handle) + (message "User %s (@%s) %sed!" name user-handle action))))))))) ;; FOLLOW TAGS @@ -2212,7 +2216,8 @@ PREFIX is sent to `mastodon-tl--get-tag-timeline', which see." (defun mastodon-tl--followed-tags-timeline (&optional prefix) "Open a timeline of multiple tags. -PREFIX is sent to `mastodon-tl--show-tag-timeline', which see. +With a single PREFIX arg, only show posts with media. +With a double PREFIX arg, limit results to your own instance. If `mastodon-tl--tag-timeline-tags' is set, use its tags, else fetch followed tags and load the first four of them." (interactive "p") @@ -2679,6 +2684,7 @@ This location is defined by a non-nil value of (mastodon-tl--buffer-type-eq 'follow-suggestions) (mastodon-tl--buffer-type-eq 'lists) (mastodon-tl--buffer-type-eq 'filters) + (mastodon-tl--buffer-type-eq 'scheduled-statuses) (mastodon-tl--search-buffer-p)) (message "update not available in this view.") ;; FIXME: handle update for search and trending buffers @@ -2745,7 +2751,7 @@ JSON and http headers, without it just the JSON." "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to receive more toots. Runs synchronously. -Optional arg NOTE-TYPE means only get that type of note. +Optional arg NOTE-TYPE means only get that type of notification. PARAMS is an alist of any params to include in the request. HEADERS are any headers to send in the request. VIEW-NAME is a string, to be used as a heading for the view. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index bffa20e..e414552 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -154,6 +154,10 @@ If the original toot visibility is different we use the more restricted one." "Whether to enable your instance's custom emoji by default." :type 'boolean) +(defcustom mastodon-toot--emojify-in-compose-buffer nil + "Whether to enable `emojify' in the compose buffer." + :type 'boolean) + (defcustom mastodon-toot--proportional-fonts-compose nil "Nonnil to enable using proportional fonts in the compose buffer. By default fixed width fonts are used." @@ -809,7 +813,8 @@ to `emojify-user-emojis', and the emoji data is updated." "Get the body of a toot from the current compose buffer." (let ((header-region (mastodon-tl--find-property-range 'toot-post-header (point-min)))) - (buffer-substring (cdr header-region) (point-max)))) + (string-trim-left + (buffer-substring (cdr header-region) (point-max))))) (defun mastodon-toot--build-poll-params () "Return an alist of parameters for POSTing a poll status." @@ -1027,6 +1032,21 @@ Federated user: `username@host.co`." (cons (match-beginning 2) (match-end 2)))))) +(defun mastodon-toot--fetch-emojify-candidates () + "Get the candidates to be used for emojis completion. +The candidates are calculated according to currently active +`emojify-emoji-styles'. Hacked off `emojify--get-completing-read-candidates'." + (let ((styles (mapcar #'symbol-name emojify-emoji-styles))) + (let ((emojis '())) + (emojify-emojis-each (lambda (key value) + (when (seq-position styles (ht-get value "style")) + (push (cons key + (format "%s (%s)" + (ht-get value "name") + (ht-get value "style"))) + emojis)))) + emojis))) + (defun mastodon-toot--fetch-completion-candidates (start end &optional type) "Search for a completion prefix from buffer positions START to END. Return a list of candidates. @@ -1041,8 +1061,7 @@ TYPE is the candidate type, it may be :tags, :handles, or :emoji." collect (cons (concat "#" (car tag)) (cdr tag))))) ((eq type :emoji) - (cl-loop for e in emojify-user-emojis - collect (car e))) + (mastodon-toot--fetch-emojify-candidates)) (t (mastodon-search--search-accounts-query (buffer-substring-no-properties start end)))))) @@ -1100,10 +1119,10 @@ arg, a candidate." ;; or make it an alist and use cdr (cadr (assoc candidate mastodon-toot-completions))) -(defun mastodon-toot--emoji-annotation-fun (_candidate) +(defun mastodon-toot--emoji-annotation-fun (candidate) "." ;; TODO: emoji image as annot - ) + (cdr (assoc candidate mastodon-toot-completions))) ;;; REPLY @@ -1698,20 +1717,13 @@ REPLY-REGION is a string to be injected into the buffer." URLs always = 23, and domain names of handles are not counted. This is how mastodon does it. CW is the content warning, which contributes to the character count." - (with-temp-buffer - (switch-to-buffer (current-buffer)) - (insert toot-string) - (goto-char (point-min)) - ;; handle URLs - (while (search-forward-regexp mastodon-toot-url-regex nil t) - ; "\\w+://[^ \n]*" old regex - (replace-match "xxxxxxxxxxxxxxxxxxxxxxx")) ; 23 x's - ;; handle @handles - (goto-char (point-min)) - (while (search-forward-regexp mastodon-toot-handle-regex nil t) - (replace-match (match-string 2))) ; replace with handle only + (let* ((url-replacement (make-string 23 ?x)) + (count-str (replace-regexp-in-string ; handle @handles + mastodon-toot-handle-regex "\2" + (replace-regexp-in-string ; handle URLs + mastodon-toot-url-regex url-replacement toot-string)))) (+ (length cw) - (length (buffer-substring (point-min) (point-max)))))) + (length count-str)))) ;;; DRAFTS diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 8e04434..d0f310b 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -509,11 +509,11 @@ JSON is the data returned by the server." "Insert scheduled TOOT into the buffer." (let-alist toot (insert - (propertize (concat .params.text + (propertize (concat (string-trim .params.text) " | " (mastodon-toot--iso-to-human .scheduled_at)) 'byline t ; so we nav here - 'item-id "0" ; so we nav here + 'item-type 'scheduled ; so we nav here 'face 'font-lock-comment-face 'keymap mastodon-views--scheduled-map 'scheduled-json toot @@ -619,6 +619,7 @@ JSON is the filters data." (insert (propertize filter-string 'item-id id ;for goto-next-filter compat + 'item-type 'filter 'phrase phrase 'byline t) ;for goto-next-filter compat "\n\n"))) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 9dac1d1..7a04c87 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -97,6 +97,8 @@ (autoload 'mastodon-views--view-instance-description "mastodon-views") (autoload 'mastodon-views--view-lists "mastodon-views") (autoload 'mastodon-views--view-scheduled-toots "mastodon-views") +(autoload 'mastodon-tl--dm-user "mastodon-tl") +(autoload 'mastodon-tl--scroll-up-command "mastodon-tl") (autoload 'special-mode "simple") (defvar mastodon-tl--highlight-current-toot) @@ -291,7 +293,7 @@ See `mastodon-toot-display-orig-in-reply-buffer'.") (buffer-list))))) ; catch any other masto buffer (mastodon-return-credential-account :force) (if buffer - (switch-to-buffer buffer) + (pop-to-buffer buffer '(display-buffer-same-window)) (mastodon-tl--get-home-timeline) (message "Loading Mastodon account %s on %s..." (mastodon-auth--user-acct) @@ -299,6 +301,11 @@ See `mastodon-toot-display-orig-in-reply-buffer'.") (defvar mastodon-profile-credential-account nil) +;; TODO: the get request in mastodon-http--get-response often returns nil +;; after waking pc from sleep, not sure how to fix, or if just my pc +;; interestingly it only happens with this function tho. +;;we have to use :force to update the credential-account object in case things +;; have been changed via another client. (defun mastodon-return-credential-account (&optional force) "Return the CredentialAccount entity. Either from `mastodon-profile-credential-account' or from the @@ -310,7 +317,12 @@ FORCE means to fetch from the server and update nil :silent))) (if force (setq mastodon-profile-credential-account - (eval req)) + ;; TODO: we should also signal a quit condition after like 5 + ;; secs here + (condition-case nil + (eval req) + (t ; req fails, return old value + mastodon-profile-credential-account))) (or mastodon-profile-credential-account (setq mastodon-profile-credential-account (eval req)))))) @@ -337,7 +349,7 @@ from the server and load anew." "*mastodon-notifications*"))) (if (and (not force) (get-buffer buffer)) - (progn (switch-to-buffer buffer) + (progn (pop-to-buffer buffer '(display-buffer-same-window)) (mastodon-tl--update)) (message "Loading your notifications...") (mastodon-tl--init-sync (or buffer-name "notifications") @@ -435,10 +447,12 @@ Calls `mastodon-tl--get-buffer-type', which see." (defun mastodon-switch-to-buffer () "Switch to a live mastodon buffer." (interactive) - (let* ((bufs (mastodon-live-buffers)) - (buf-names (mapcar #'buffer-name bufs)) - (choice (completing-read "Switch to mastodon buffer: " - buf-names))) + (let ((choice (read-buffer + "Switch to mastodon buffer: " nil t + (lambda (cand) + (with-current-buffer + (if (stringp cand) cand (car cand)) + (mastodon-tl--get-buffer-type)))))) (switch-to-buffer choice))) (defun mastodon-mode-hook-fun () |