From: Andreas Gerler Date: Sun, 22 Dec 2024 12:49:13 +0000 (+0100) Subject: add tp X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=7b3041429600af0c3bad45021ee90fc9b3eb583e;p=emacsconfig.git add tp Signed-off-by: Andreas Gerler --- diff --git a/elpa/tp-20241031.729/tp-autoloads.el b/elpa/tp-20241031.729/tp-autoloads.el new file mode 100644 index 00000000..cabf883b --- /dev/null +++ b/elpa/tp-20241031.729/tp-autoloads.el @@ -0,0 +1,28 @@ +;;; tp-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from tp.el + +(register-definition-prefixes "tp" '("tp-")) + +;;; End of scraped data + +(provide 'tp-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; tp-autoloads.el ends here diff --git a/elpa/tp-20241031.729/tp-pkg.el b/elpa/tp-20241031.729/tp-pkg.el new file mode 100644 index 00000000..705a81f0 --- /dev/null +++ b/elpa/tp-20241031.729/tp-pkg.el @@ -0,0 +1,11 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "tp" "20241031.729" + "Utilities for transient menus that POST to an API." + '((emacs "28.1") + (transient "0.5.0")) + :url "https://codeberg.org/martianh/tp.el" + :commit "df6490d86f24fff22f5ea4f7d887fc60caed1163" + :revdesc "df6490d86f24" + :keywords '("convenience" "api" "requests") + :authors '(("Marty Hiatt" . "mousebot@disroot.org")) + :maintainers '(("Marty Hiatt" . "mousebot@disroot.org"))) diff --git a/elpa/tp-20241031.729/tp.el b/elpa/tp-20241031.729/tp.el new file mode 100644 index 00000000..9fcc52b1 --- /dev/null +++ b/elpa/tp-20241031.729/tp.el @@ -0,0 +1,418 @@ +;;; tp.el --- Utilities for transient menus that POST to an API -*- lexical-binding: t; -*- + +;; Author: Marty Hiatt +;; Copyright (C) 2024 Marty Hiatt +;; Package-Version: 20241031.729 +;; Package-Revision: df6490d86f24 +;; Package-Requires: ((emacs "28.1") (transient "0.5.0")) +;; Keywords: convenience, api, requests +;; URL: https://codeberg.org/martianh/tp.el + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; Some functions, classes and methods to make it easier to create +;; transient menus that send complex POST, PUT, or PATCH requests to JSON +;; APIs. + +;; A typical use-case is where you have a single endpoint that takes many +;; different parameters. It's handy for a user to be able to set all the +;; options, then make a single request to change all the settings on the +;; server. It's also expected that they'll be able to view all the current +;; settings on the server, and make modifications to them for sending. + +;; The classes and methods define some transient behaviours that make +;; sense for dealing with APIs: + +;; - We handle fetching and saving current server settings, and initialize +;; our transients with the values fetched +;; - We compare the state of a current transient option against the server +;; values +;; - We distinguish the formatting of server settings and current transient +;; setting +;; - When reading a string from the user, we provide the server setting as +;; default input +;; - We can seemlessly handle making requests with arrays, i.e. =source[key]=, +;; or =field[1][name]= parameters +;; - We can easily fetch an infix's allowed values for =completing-read= +;; - We (ususally) only send changed values to the server. + + +;;; Code: + +(require 'transient) +(require 'json) + +;;; VARIABLES + +(defvar tp-choice-booleans '("true" "false") + "Boolean strings for sending non-JSON requests.") + +(defvar tp-transient-settings nil + "Settings for the current transient prefix. +This can hold either the default settings data (editable) as +returned by a server, or alternatively the transient's current +settings if it is only stored when completed, and may be edited +again before being sent.") + +;;; UTILS + +(defun tp-remove-not-editable (alist var) + "Remove non-editable fields from ALIST. +Check against the fields in VAR, which should be a list of strings." + (cl-remove-if-not + (lambda (x) + (member (symbol-name (car x)) + var)) + alist)) + +(defun tp-return-data (fetch-fun &optional editable-var field) + "Return data to populate current settings. +Call FETCH-FUN with zero arguments to GET the data. Cull the data +with `tp-remove-not-editable', bind the result to +`tp-transient-settings' and return it. +EDITABLE-VAR is a variable containing a list of strings +corresponding to the editable fields of the JSON data returned. +See `tp-remove-not-editable'. +FIELD is a JSON field to set `tp-transient-settings' to, fetched +with `alist-get'." + (let* ((data (funcall fetch-fun)) + (editable (if editable-var + (tp-remove-not-editable data editable-var) + data))) + (setq tp-transient-settings + (if field + (alist-get field editable) + editable)))) + +(defun tp-only-changed-args (alist) + "Remove elts from ALIST if value is changed. +Values are considered changed if they do not match those in +`tp-transient-settings'. Nil values are also removed if they +match the empty string. +If ALIST contains dotted.notation keys, we drill down into +`tp-transient-settings' to check the value." + (prog1 + (cl-remove-if + (lambda (x) + (let* ((split (split-string (symbol-name (car x)) "\\.")) + (server-val + (if (< 1 (length split)) + ;; FIXME: handle arbitrary nesting: + (alist-get (intern (cadr split)) + (alist-get (intern (car split)) + tp-transient-settings)) + (alist-get (car x) + tp-transient-settings)))) + (cond ((not (cdr x)) (equal "" server-val)) + (t (equal (cdr x) server-val))))) + alist) + ;; unset our vars (comment if need to inspect): + (setq tp-transient-settings nil))) + +(defun tp-bool-to-str (cons) + "Convert CONS, into a string boolean if it is either t or :json-false. +Otherwise just return CONS." + (if (not (consp cons)) + cons + (cons (car cons) + (cond ((eq :json-false (cdr cons)) "false") + ((eq t (cdr cons)) "true") + (t (cdr cons)))))) + +(defun tp-bool-str-to-json (cons) + "Convert CONS, into a string boolean if it is either t or :json-false. +Otherwise just return CONS." + ;; do nothing if not a cons: `-tree-map' doesn't handle parsed JSON well + (if (not (consp cons)) + cons + (cons (car cons) + (cond ((equal "false" (cdr cons)) :json-false) + ((equal "true" (cdr cons)) t) + (t (cdr cons)))))) + +(defun tp-tree-map (fn tree) + "Apply FN to each element of TREE while preserving the tree structure. +This is just `-tree-map' from the dash library." + ;; (declare (important-return-value t)) ;; commented for older emacsen + (cond + ((null tree) ()) + ;; the smallest element this operates on is not a list item, but a cons + ;; pair, e.g. (a . b): + ((nlistp (cdr-safe tree)) ;; ie `-cons-pair?' + (funcall fn tree)) + ((consp tree) + (mapcar (lambda (x) (tp-tree-map fn x)) tree)) + ((funcall fn tree)))) + +(defun tp-bools-to-strs (alist) + "Convert values in ALIST to string booleans if they are JSON booleans." + (tp-tree-map + #'tp-bool-to-str alist)) + +(defun tp-bool-strs-to-json (alist) + "Convert values in ALIST to string booleans if they are JSON booleans." + (tp-tree-map + #'tp-bool-str-to-json alist)) + +(defun tp-dots-to-arrays (alist &optional only-last-two parent-suffix) + "Convert keys in ALIST tp dot annotation to array[key] annotation. +If ONLY-LAST-TWO is non-nil, return only secondlast[last] from +KEY. +PARENT-SUFFIX is appended to the first element." + ;; FIXME: handle multi dots? + (cl-loop for a in alist + collect (cons (tp-dot-to-array (symbol-name (car a)) + only-last-two parent-suffix) + (cdr a)))) + +(defun tp-dot-to-array (key &optional only-last-two parent-suffix) + "Convert KEY from tp dot annotation to array[key] annotation. +Handles multiple values by calling `tp-dot-to-array-multi', which +see. +If ONLY-LAST-TWO is non-nil, return only secondlast[last] from +KEY. +PARENT-SUFFIX is appended to the first element." + (let* ((split (split-string key "\\."))) + (cond ((not key) nil) + ((= 1 (length split)) key) + (only-last-two + (concat ;; but last item + (car (last split 2)) + ;; last item + "[" (car (last split)) "]")) + (t (tp-dot-to-array-multi split parent-suffix))))) + +(defun tp-dot-to-array-multi (list parent-suffix) + "Wrap all elements of LIST in [square][brackets] save the first. +Concatenate the results together. +PARENT-SUFFIX is appended to the first element." + (mapconcat + (lambda (x) + (if (equal x (car list)) + (if parent-suffix + (concat x parent-suffix) + x) + (concat"[" x "]"))) + list)) + +(defun tp--get-choices (obj) + "Return the value contained in OBJ's choices-slot. +It might be a symbol, in which case evaluate it, a function, in +which case call it. else just return it." + (let ((slot (oref obj choices))) + (cond ((functionp slot) + (funcall slot)) + ((symbolp slot) + (symbol-value slot)) + (t slot)))) + +(defun tp-parse-args-for-send (args &optional strings) + "Parse ARGS, an alist of args for sending. +If STRINGS is non-nil, convert elisp JSON booleans into string +booleans." + (let* ((changed (tp-only-changed-args args)) + (arrays (tp-dots-to-arrays changed))) + (if strings + (tp-bools-to-strs arrays) + arrays))) + +;; CLASSES + +(defclass tp-option (transient-option) + ((always-read :initarg :always-read :initform t) + (alist-key :initarg :alist-key)) ;; :key slot already taken! + "An infix option class for our options. +We always read.") + +(defclass tp-option-str (tp-option) + ((format :initform " %k %d %v")) + "An infix option class for our option strings. +We always read, and our reader provides initial input from +default/current values.") + +(defclass tp-bool (tp-option) + ((format :initform " %k %d %v") + (choices :initarg :choices :initform + (lambda () tp-choice-booleans))) + "An option class for our choice booleans. +We implement this as an option because we need to be able to +explicitly send true/false values to the server, whereas +transient ignores false/nil values.") + +;;; TRANSIENT METHODS +;; for `tp-bool' we define our own infix option that displays +;; [true|false] like exclusive switches. activating the infix +;; moves to the next option. + +(cl-defmethod transient-infix-value ((obj tp-option)) + "Return the infix value of OBJ as a cons cell." + (cons (oref obj alist-key) + (oref obj value))) + +(cl-defmethod transient-init-value ((obj tp-option)) + "Initialize the value of OBJ." + (let* ((prefix-val (oref transient--prefix value))) + (oset obj value + (tp-get-server-val obj prefix-val)))) + +(cl-defmethod transient-format-value ((obj tp-option)) + "Format the value of OBJ. +Format should just be a string, highlighted green if it has been +changed from the server value." + (let* ((cons (transient-infix-value obj)) + (value (when cons (cdr cons)))) + (if (not value) + "" + (propertize value + 'face (if (tp-arg-changed-p obj cons) + 'transient-value + 'transient-inactive-value))))) + +(defvar tp-json-bool-alist + '((t . "true") + (:json-false . "false")) + "An alist for JSON booleans and boolean strings.") + +(defun tp-get-bool-str (bool) + "Given a JSON BOOL, return its string boolean." + (alist-get bool tp-json-bool-alist)) + +(defun tp-active-face-maybe (obj cons) + "Return a face spec based on OBJ's value and CONS." + (let* ((value (oref obj value)) + (active-p (equal (cdr cons) + (if (symbolp value) + (tp-get-bool-str value) + value))) + (changed-p (tp-arg-changed-p obj cons))) + ;; FIXME: differentiate init server value + ;; from switching to other value then switching + ;; back to server value? + (cond ((and active-p changed-p) + 'transient-value) + ((and active-p (not changed-p)) + '(:inherit transient-value :underline t)) + ((and (not active-p) (not changed-p)) + '(:inherit transient-inactive-value :underline t)) + (t + 'transient-inactive-value)))) + +(cl-defmethod transient-format-value ((obj tp-bool)) + "Format the value of OBJ. +Format should be like \"[opt1|op2]\", with the active option highlighted. +The value currently on the server should be underlined." + (let* ((key (oref obj alist-key)) + (choices (tp--get-choices obj))) + (concat + (propertize "[" + 'face 'transient-inactive-value) + (mapconcat + (lambda (choice) + (let ((cons (cons key choice))) + (propertize + choice + 'face (tp-active-face-maybe obj cons)))) + choices + (propertize "|" 'face 'transient-inactive-value)) + (propertize "]" 'face 'transient-inactive-value)))) + +(cl-defmethod transient-infix-read ((obj tp-bool)) + "Cycle through the possible values of OBJ." + (let* ((cons (transient-infix-value obj)) + (val (tp-get-bool-str (cdr cons))) + (choices (tp--get-choices obj)) + (str (if (or (not val) ;; handle nil value + (equal val (car (last choices)))) + (car choices) + (cadr (member val choices))))) + ;; return JSON bool: + ;; FIXME: breaks using `tp-bool' for cycling other items! + (car (rassoc str tp-json-bool-alist)))) + +;; FIXME: see the `transient-infix-read' method's docstring: +;; we should preserve history, follow it. maybe just mod it. +(cl-defmethod transient-infix-read ((obj tp-option-str)) + "Reader function for OBJ. +We add the current value as initial input." + (let* ((value (transient-infix-value obj)) + (prompt (transient-prompt obj))) + (read-string prompt (cdr value)))) + +(cl-defmethod transient-prompt ((obj tp-option)) + "Format a prompt for OBJ." + (let* ((key (oref obj alist-key)) + (split (split-string (symbol-name key) "\\.")) + (str (string-replace "_" " " (car (last split))))) + (format "%s: " str))) + +(cl-defmethod transient-infix-read ((obj tp-option)) + "Cycle through the possible values of OBJ." + (let* ((prompt (transient-prompt obj)) + (choices (tp--get-choices obj))) + (completing-read prompt choices nil :match))) + +;;; OUR METHODS + +(cl-defmethod tp-arg-changed-p ((obj tp-option) cons) + "T if value of CONS is different to the value in `tp-transient-settings'. +The format of the value is a transient pair as a string, ie \"key=val\". +Nil values will also match the empty string. +OBJ is the object whose args are being checked." + (let* ((data (oref transient--prefix value)) + (server-val (tp-get-server-val obj data)) + (server-str (if (and server-val + (symbolp server-val)) + (tp-get-bool-str server-val) + server-val))) + (not (equal (cdr cons) server-str)))) + +(cl-defmethod tp-get-server-val ((obj tp-option) data) + "Return the server value for OBJ from DATA. +If OBJ's key has dotted notation, drill down into the alist. Currently +only one level of nesting is supported." + ;; TODO: handle nested alist keys + (let* ((key (oref obj alist-key)) + (split (split-string (symbol-name key) "\\."))) + (cond ((= 1 (length split)) + (alist-get key data)) + ((= 2 (length split)) + (alist-get (intern (cadr split)) + (alist-get (intern (car split)) data)))))) + +;;; VARIABLE CLASS + +;; a class used to implement `transient-init-value' in a way that doesn't +;; fetch from a server, but merely gets data from `tp-transient-settings'. +;; this hopefully means you can multi-inherit from this class and another, +;; and not have to implement `transient-init-value' for each of your +;; class(es). + +;; it seems like for this to work right, tp-option-var should be the +;; second, not first, superclass. e.g. (defclass your-tp-option (tp-option +;; tp-option-var) (())) + +(defclass tp-option-var (tp-option) + (())) + +(cl-defmethod transient-init-value ((obj tp-option-var)) + "Initialize OBJ, an option. +Pull value from `tp-transient-settings' if possible.'" + (let ((key (oref obj alist-key))) + (oset obj value + (alist-get key tp-transient-settings)))) + +(provide 'tp) +;;; tp.el ends here