From eb240166ace2f1d73083aa12635e6bf6ddea10a7 Mon Sep 17 00:00:00 2001 From: SqrtMinusOne Date: Thu, 20 Jul 2023 00:52:29 +0300 Subject: [PATCH] biome-grid: basic tabulated-list display works --- biome-api.el | 10 +++--- biome-grid.el | 92 ++++++++++++++++++++++++++++++++++++++++++++++++++ biome-query.el | 19 +++++++---- 3 files changed, 110 insertions(+), 11 deletions(-) create mode 100644 biome-grid.el diff --git a/biome-api.el b/biome-api.el index 7091aa2..292bd71 100644 --- a/biome-api.el +++ b/biome-api.el @@ -77,19 +77,19 @@ QUERY is a form as defined by `biome-query-current'." (interactive) (quit-window t)) -(defvar open-meteo-error-mode-map +(defvar biome-api-error-mode-map (let ((keymap (make-sparse-keymap))) (define-key keymap (kbd "q") #'biome-error-quit) (when (fboundp 'evil-define-key*) (evil-define-key* 'normal keymap "q" #'biome-error-quit)) keymap) - "Keymap for `open-meteo-error-mode'.") + "Keymap for `biome-api-error-mode'.") -(define-derived-mode open-meteo-error-mode text-mode "Lyrics view" +(define-derived-mode biome-api-error-mode text-mode "Lyrics view" "Major mode for viewing open meteo errors. -\\{open-meteo-error-mode-map}" +\\{biome-api-error-mode-map}" (read-only-mode 1)) (defun biome-api--show-error (error-thrown response) @@ -107,7 +107,7 @@ QUERY is a form as defined by `biome-query-current'." "\n") (insert "Can't parse reason. Raw response: ") (insert (prin1-to-string response))) - (open-meteo-error-mode)) + (biome-api-error-mode)) (switch-to-buffer buffer))) (defun biome-api-get (query callback) diff --git a/biome-grid.el b/biome-grid.el new file mode 100644 index 0000000..2c7d2ce --- /dev/null +++ b/biome-grid.el @@ -0,0 +1,92 @@ +;;; biome-grid.el --- Display results of open meteo queries -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Korytov Pavel + +;; Maintainer: Korytov Pavel +;; Homepage: https://github.com/SqrtMinusOne/biome + +;; This file is NOT part of GNU Emacs. + +;; 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: + +;; TODO + +;;; Code: +(require 'cl-lib) +(require 'biome-query) +(require 'tabulated-list) + +(defcustom biome-grid-display-units t + "Display units in the grid." + :type 'boolean + :group 'biome) + +(define-derived-mode biome-grid-mode tabulated-list-mode "Biome Grid" + "Major mode for displaying biome results." + (setq-local truncate-lines t)) + +(defun biome-grid--format-entries (entries unit) + (mapcar + (lambda (entry) + (if (stringp entry) + entry + (prin1-to-string entry))) + entries)) + +(defun biome-grid--get-width (entries col-name) + (cl-loop for entry in (cons col-name entries) + maximize (length entry))) + +(defun biome-grid--set-list (query results) + (let* ((group (intern (alist-get :group query))) + (group-units (intern (format "%s_units" (alist-get :group query)))) + (var-names (biome-query--get-var-names-cache)) + all-entries columns) + (cl-loop for (key . values) in (alist-get group results) + for unit = (alist-get key (alist-get group-units results)) + for var-name = (biome-query--get-header (symbol-name key) var-names) + for col-name = (if biome-grid-display-units + (format "%s (%s)" var-name unit) + var-name) + for entries = (biome-grid--format-entries values unit) + for col-width = (biome-grid--get-width entries col-name) + do (push (list col-name col-width nil) columns) + do (push entries all-entries)) + (setq-local + tabulated-list-format (vconcat (nreverse columns)) + tabulated-list-entries + (seq-map-indexed + (lambda (entries i) + (list i (vconcat entries))) + (cl-reduce (lambda (acc entries) + (cl-loop for entry in entries + for i from 0 + do (setf (aref acc i) + (cons entry (aref acc i)))) + acc) + all-entries + :initial-value (make-vector (length (car all-entries)) nil)))))) + +(defun biome-grid (query results) + "Display RESULTS in a grid." + (let ((buf (generate-new-buffer "*biome-grid*"))) + (with-current-buffer buf + (biome-grid--set-list query results) + (biome-grid-mode)) + (display-buffer buf #'display-buffer-same-window))) + +(provide 'biome-grid) +;;; biome-grid.el ends here diff --git a/biome-query.el b/biome-query.el index 8aa5c60..72a0859 100644 --- a/biome-query.el +++ b/biome-query.el @@ -133,6 +133,11 @@ case, the value is a list of variable names available in the group.") nil nil #'equal) cache)))) +(defun biome-query--get-header (key var-names) + (gethash key var-names + (capitalize (replace-regexp-in-string + (regexp-quote "_") " " key)))) + (cl-defmethod transient-format ((_ biome-query--transient-report)) "Format the current report." (let ((group (alist-get :group biome-query-current)) @@ -141,10 +146,12 @@ case, the value is a list of variable names available in the group.") (dolist (item (alist-get :params biome-query-current)) (cond ((stringp item) - (push (gethash item var-names) vars)) + (push (biome-query--get-header item var-names) vars)) ((equal (car item) group) - (setq group-vars (mapcar (lambda (x) (gethash x var-names)) - (cdr item)))) + (setq group-vars + (mapcar (lambda (x) + (biome-query--get-header x var-names)) + (cdr item)))) ((equal (car item) "latitude") (setq lat (cdr item))) ((equal (car item) "longitude") @@ -152,7 +159,7 @@ case, the value is a list of variable names available in the group.") ((member (car item) '("end_date" "start_date")) (push (format "%s: %s" (propertize - (gethash (car item) var-names (capitalize (car item))) + (biome-query--get-header (car item) var-names) 'face 'font-lock-variable-name-face) (propertize (format-time-string biome-query-date-format (cdr item)) @@ -161,7 +168,7 @@ case, the value is a list of variable names available in the group.") ((listp (cdr item)) (push (format "%s: %s" - (gethash (car item) var-names (capitalize (car item))) + (biome-query--get-header (car item) var-names) (propertize (mapconcat #'identity (cdr item) "; ") 'face 'font-lock-variable-name-face)) @@ -169,7 +176,7 @@ case, the value is a list of variable names available in the group.") (t (push (format "%s: %s" (propertize - (gethash (car item) var-names (capitalize (car item))) + (biome-query--get-header (car item) var-names) 'face 'font-lock-variable-name-face) (propertize (prin1-to-string (cdr item))