aboutsummaryrefslogtreecommitdiff
path: root/lisp/mastodon-widget.el
diff options
context:
space:
mode:
authormarty hiatt <martianhiatus@disroot.org>2024-10-29 10:17:57 +0100
committermarty hiatt <martianhiatus@disroot.org>2024-10-29 10:17:57 +0100
commitbc11edccc2c292972e2e0c08bc81a9e29c2cf048 (patch)
tree3dfd1b191998b7369e8812c449b87a637726d43d /lisp/mastodon-widget.el
parent31df8d9a0ae57342961ff46fe032c6871d2cefbb (diff)
parent7d23c74ed57a56a1a0b640c4cf443c269486ab09 (diff)
Merge branch 'develop'
Diffstat (limited to 'lisp/mastodon-widget.el')
-rw-r--r--lisp/mastodon-widget.el101
1 files changed, 101 insertions, 0 deletions
diff --git a/lisp/mastodon-widget.el b/lisp/mastodon-widget.el
new file mode 100644
index 0000000..a326800
--- /dev/null
+++ b/lisp/mastodon-widget.el
@@ -0,0 +1,101 @@
+;;; 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%] "
+ :keymap ,mastodon-widget-keymap)))
+
+(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 (if (symbolp type)
+ (symbol-value type)
+ 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