aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormarty hiatt <martianhiatus@disroot.org>2024-10-27 09:41:24 +0100
committermarty hiatt <martianhiatus@disroot.org>2024-10-27 10:08:02 +0100
commitc7c2cfdf3a4aa47a41a493369c0c9e2512712dd1 (patch)
treeda843dc9c98dcbf8bb77d2a3ca734dc54c74e74a
parenta40eeddbfd754c651b8a8dbb7919b6db4cd8a67c (diff)
refactor mastodon-widget.el, add profile tagged statuses to widget. #607
-rw-r--r--lisp/mastodon-profile.el137
-rw-r--r--lisp/mastodon-widget.el98
2 files changed, 134 insertions, 101 deletions
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 37e66ea..b7cbc7f 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -40,6 +40,7 @@
(require 'mastodon-http)
(eval-when-compile
(require 'mastodon-tl))
+(require 'mastodon-widget)
(autoload 'mastodon-auth--get-account-id "mastodon-auth")
(autoload 'mastodon-auth--get-account-name "mastodon-auth.el")
@@ -550,6 +551,30 @@ The endpoint only holds a few preferences. For others, see
"\n\n"))
(goto-char (point-min)))))
+
+;;; PROFILE WIDGET
+
+(defvar mastodon-profile--views-plist
+ `(:kind "View" :types mastodon-profile--view-types :default statuses))
+
+(defvar mastodon-profile--view-types
+ '(statuses no-boosts no-replies only-media followers following tag))
+
+(defvar mastodon-profile--load-funs-alist
+ `((statuses . mastodon-profile--open-statuses)
+ (no-boosts . mastodon-profile--open-statuses-no-reblogs)
+ (no-replies . mastodon-profile--open-statuses-no-replies)
+ (only-media . mastodon-profile--open-statuses-only-media)
+ (followers . mastodon-profile--open-followers)
+ (following . mastodon-profile--open-following)
+ (tag . mastodon-profile--open-statuses-tagged)))
+
+(defun mastodon-profile--view-fun-call (type)
+ "Call the function associated with TYPE.
+Fetched from `mastodon-profile--load-funs-alist'."
+ (funcall
+ (alist-get type mastodon-profile--load-funs-alist)))
+
;;; PROFILE VIEW DETAILS
@@ -726,15 +751,17 @@ MAX-ID is a flag to include the max_id pagination parameter."
(setq mastodon-tl--update-point (point))
(mastodon-media--inline-images (point-min) (point))
;; widget items description
- (mastodon-profile--widget-create
+ (mastodon-widget--create
(plist-get mastodon-profile--views-plist :kind)
- ;; (car mastodon-profile--views-plist)
(plist-get mastodon-profile--views-plist :types)
;; TODO: hand current view to the widget:
(or (mastodon-profile--current-view-type
- endpoint-type no-reblogs no-replies only-media)
- (plist-get mastodon-profile--views-plist :default)))
- (insert "\n\n")))
+ endpoint-type no-reblogs no-replies only-media tag)
+ (plist-get mastodon-profile--views-plist :default))
+ (lambda (widget &rest _ignore)
+ (let ((value (widget-value widget)))
+ (mastodon-profile--view-fun-call value))))
+ (insert "\n")))
;; split insert of items from insert of profile:
(with-current-buffer buffer
(let* ((inhibit-read-only t))
@@ -752,15 +779,15 @@ MAX-ID is a flag to include the max_id pagination parameter."
only media, followers, following.
\\`C-c C-s' to search user's toots, \\`C-c \#' to search user's posts for a hashtag.")))))))
-(defun mastodon-profile--current-view-type (type no-reblogs no-replies only-media)
+(defun mastodon-profile--current-view-type (type no-reblogs no-replies
+ only-media tag)
"Return the type of current profile view.
Return a member of `mastodon-profile--view-types', based on TYPE,
-NO-REBLOGS, NO-REPLIES and ONLY-MEDIA."
+NO-REBLOGS, NO-REPLIES, ONLY-MEDIA and TAG."
(cond (no-reblogs 'no-boosts)
(no-replies 'no-replies)
(only-media 'only-media)
- ;; (tag
- ;; (format " TOOTS (containing #%s)" tag))
+ (tag 'tag)
(t (intern type))))
(defun mastodon-profile--format-joined-date-string (joined)
@@ -1048,97 +1075,5 @@ the given account."
(let ((choice (completing-read "Show profile of user: " handles)))
(mastodon-profile--show-user choice)))))
-
-;;; PROFILE WIDGET (ported from lem-ui.el)
-
-(defvar mastodon-profile-widget-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [down-mouse-2] 'widget-button-click)
- (define-key map [down-mouse-1] 'widget-button-click)
- (define-key map [touchscreen-begin] 'widget-button-click)
- ;; The following definition needs to avoid using escape sequences that
- ;; might get converted to ^M when building loaddefs.el
- (define-key map [(control ?m)] 'widget-button-press)
- map)
- "Keymap containing useful binding for buffers containing widgets.
-Recommended as a parent keymap for modes using widgets.
-Note that such modes will need to require wid-edit.")
-
-(defface mastodon-profile-widget-face
- '((t :inherit font-lock-function-name-face :weight bold :underline t))
- "Face for widgets.")
-
-(defvar mastodon-profile--views-plist
- `(:kind "View" :types mastodon-profile--view-types :default statuses))
-
-(defvar mastodon-profile--view-types
- ;; there's also tags, but it has to be a partic tag
- '(statuses no-boosts no-replies only-media followers following))
-
-(defvar mastodon-profile--load-funs-alist
- `((statuses . mastodon-profile--open-statuses)
- (no-boosts . mastodon-profile--open-statuses-no-reblogs)
- (no-replies . mastodon-profile--open-statuses-no-replies)
- (only-media . mastodon-profile--open-statuses-only-media)
- (followers . mastodon-profile--open-followers)
- (following . mastodon-profile--open-following)))
-
-(defun mastodon-profile--view-fun-call (type)
- "Call the function associated with TYPE.
-Fetched from `mastodon-profile--load-funs-alist'."
- (funcall
- (alist-get type mastodon-profile--load-funs-alist)))
-
-(defun mastodon-profile--return-item-widgets (list)
- "Return a list of item widgets for each item, a string, in LIST."
- (cl-loop for x in list
- collect `(choice-item :value ,x :format "%[%v%] ")))
-
-(defun mastodon-profile--widget-format (str &optional padding)
- "Return a widget format string for STR, its name.
-PADDING is an integer, for how much right-side padding to add."
- (concat "%[" (propertize str
- 'face 'mastodon-profile-widget-face
- 'mastodon-tab-stop t)
- "%]: %v"
- (make-string padding ? )))
-
-(defun mastodon-profile--widget-notify-fun (_old-value)
- "Return a widget notify function.
-OLD-VALUE is the widget's value before being changed."
- `(lambda (widget &rest ignore)
- (let ((value (widget-value widget))
- (tag (widget-get widget :tag)))
- (pcase tag
- ("views" (mastodon-profile--view-fun-call value))
- (_ (message "Widget kind not implemented yet"))))))
-
-(defun mastodon-profile--widget-create (kind type value)
- "Return a widget of KIND, with TYPE-LIST elements, and default VALUE.
-KIND is a string, either Listing, Sort, Items, or Inbox, and will
-be used for the widget's tag.
-VALUE is a string, a member of TYPE."
- (let* ((val-length (length (if (symbolp value)
- (symbol-name value)
- value)))
- (type-list (symbol-value type))
- (longest (apply #'max
- (mapcar #'length
- (if (symbolp (car type-list))
- (mapcar #'symbol-name type-list)
- type-list))))
- (padding (- longest val-length)))
- (if (not (member value type-list))
- (user-error "%s is not a member of %s" value type-list)
- (widget-create
- 'menu-choice
- :tag kind
- :value value
- :args (mastodon-profile--return-item-widgets type-list)
- :help-echo (format "Select a %s kind" kind)
- :format (mastodon-profile--widget-format kind padding)
- :notify (mastodon-profile--widget-notify-fun value)
- :keymap mastodon-profile-widget-keymap))))
-
(provide 'mastodon-profile)
;;; mastodon-profile.el ends here
diff --git a/lisp/mastodon-widget.el b/lisp/mastodon-widget.el
new file mode 100644
index 0000000..0c1026c
--- /dev/null
+++ b/lisp/mastodon-widget.el
@@ -0,0 +1,98 @@
+;;; mastodon-widget.el --- Widget utilities -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: Marty Hiatt <mousebot@disroot.org>
+;; Maintainer: Marty Hiatt <mousebot@disroot.org>
+;; Homepage: https://codeberg.org/martianh/mastodon.el
+
+;; This file is not part of GNU Emacs.
+
+;; This file is part of mastodon.el.
+
+;; mastodon.el is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; mastodon.el is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; some widget utilities for mastodon.el
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defvar mastodon-widget-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [down-mouse-2] 'widget-button-click)
+ (define-key map [down-mouse-1] 'widget-button-click)
+ (define-key map [touchscreen-begin] 'widget-button-click)
+ ;; The following definition needs to avoid using escape sequences that
+ ;; might get converted to ^M when building loaddefs.el
+ (define-key map [(control ?m)] 'widget-button-press)
+ map)
+ "Keymap containing useful binding for buffers containing widgets.
+Recommended as a parent keymap for modes using widgets.
+Note that such modes will need to require wid-edit.")
+
+(defface mastodon-widget-face
+ '((t :inherit font-lock-function-name-face :weight bold :underline t))
+ "Face for widgets.")
+
+(defun mastodon-widget--return-item-widgets (list)
+ "Return a list of item widgets for each item, a string, in LIST."
+ (cl-loop for x in list
+ collect `(choice-item :value ,x :format "%[%v%] ")))
+
+(defun mastodon-widget--format (str &optional padding)
+ "Return a widget format string for STR, its name.
+PADDING is an integer, for how much right-side padding to add."
+ (concat "%[" (propertize str
+ 'face 'mastodon-widget-face
+ 'mastodon-tab-stop t)
+ "%]: %v"
+ (make-string padding ? )))
+
+(defun mastodon-widget--create (kind type value notify-fun)
+ "Return a widget of KIND, with TYPE elements, and default VALUE.
+KIND is a string, either Listing, Sort, Items, or Inbox, and will
+be used for the widget's tag.
+VALUE is a string, a member of TYPE.
+NOTIFY-FUN is the widget's notify function."
+ (let* ((val-length (length (if (symbolp value)
+ (symbol-name value)
+ value)))
+ (type-list (symbol-value type))
+ (longest (apply #'max
+ (mapcar #'length
+ (if (symbolp (car type-list))
+ (mapcar #'symbol-name type-list)
+ type-list))))
+ (padding (- longest val-length)))
+ (if (not (member value type-list))
+ (user-error "%s is not a member of %s" value type-list)
+ (widget-create
+ 'menu-choice
+ :tag kind
+ :value value
+ :args (mastodon-widget--return-item-widgets type-list)
+ :help-echo (format "Select a %s kind" kind)
+ :format (mastodon-widget--format kind padding)
+ :notify notify-fun
+ ;; eg format of notify-fun:
+ ;; (lambda (widget &rest ignore)
+ ;; (let ((value (widget-value widget))
+ ;; (tag (widget-get widget :tag)))
+ ;; (notify-fun value)))
+ :keymap mastodon-widget-keymap))))
+
+(provide 'mastodon-widget)
+;;; mastodon-widget.el ends here