mirror of
https://codeberg.org/cage/tinmop/
synced 2025-03-02 09:57:48 +01:00
- [GUI] added history management.
This commit is contained in:
cage
parent
06df9318ab
commit
5e9653a86c
@ -3589,9 +3589,11 @@ Note: `status-id' must identify at least a row in the database."
|
||||
(strip-prefix +folder-tag-prefix+ maybe-folder))
|
||||
|
||||
(defun gemini-history-rows (days-from days-to prompt)
|
||||
"Return past data included in ( days-from, days-to]
|
||||
"Return past data included in (days-from, days-to].
|
||||
|
||||
So if asking for data today and yesterday
|
||||
(days-from = 1 and days-to = 0), will return the data from today only.
|
||||
|
||||
Rows are ordered from the most recent to the oldest."
|
||||
(let ((actual-days-from (misc:modify-timestamp
|
||||
(misc:modify-timestamp (misc:time-n-days-ago days-from)
|
||||
|
||||
109
src/gui/client/history-window.lisp
Normal file
109
src/gui/client/history-window.lisp
Normal file
@ -0,0 +1,109 @@
|
||||
(in-package :client-history-window)
|
||||
|
||||
(named-readtables:in-readtable nodgui.syntax:nodgui-syntax)
|
||||
|
||||
(defclass history-frame (gui:frame)
|
||||
((interval-selection
|
||||
:initform nil
|
||||
:initarg :interval-selection
|
||||
:accessor interval-selection)
|
||||
(links-selection
|
||||
:initform nil
|
||||
:initarg :links-selection
|
||||
:accessor links-selection)))
|
||||
|
||||
(defun today-label ()
|
||||
(_ "Today"))
|
||||
|
||||
(defun yesterday-label ()
|
||||
(_ "Yesterday"))
|
||||
|
||||
(defun last-week-label ()
|
||||
(_ "Last week"))
|
||||
|
||||
(defun last-two-weeks-label ()
|
||||
(_ "Latest two weeks"))
|
||||
|
||||
(defun last-month-label ()
|
||||
(_ "Last month"))
|
||||
|
||||
(defun last-year-label ()
|
||||
(_ "Last year"))
|
||||
|
||||
(defun all-labels ()
|
||||
(list (today-label)
|
||||
(yesterday-label)
|
||||
(last-week-label)
|
||||
(last-two-weeks-label)
|
||||
(last-month-label)
|
||||
(last-year-label)))
|
||||
|
||||
(defun slice-label->interval (label)
|
||||
(cond
|
||||
((string= label (today-label))
|
||||
(values 1 0))
|
||||
((string= label (yesterday-label))
|
||||
(values 2 1))
|
||||
((string= label (last-week-label))
|
||||
(values 7 0))
|
||||
((string= label (last-two-weeks-label))
|
||||
(values 15 0))
|
||||
((string= label (last-month-label))
|
||||
(values 30 0))
|
||||
((string= label (last-year-label))
|
||||
(values 365 0))))
|
||||
|
||||
(defmethod initialize-instance :after ((object history-frame) &key &allow-other-keys)
|
||||
(let ((interval-selection (make-instance 'gui:scrolled-listbox
|
||||
:master object
|
||||
:text (_ "Time slice")))
|
||||
(links-selection (make-instance 'gui-mw:searchable-listbox
|
||||
:entry-label (_ "Filter (regexp): ")
|
||||
:key (lambda (a) (getf a :input))
|
||||
:remove-non-matching-p t
|
||||
:master object)))
|
||||
(setf (interval-selection object) interval-selection
|
||||
(links-selection object) links-selection)
|
||||
(gui:listbox-append interval-selection (all-labels))
|
||||
(gui:grid interval-selection 0 0 :sticky :news)
|
||||
(gui:grid links-selection 0 1 :sticky :news)
|
||||
(gui:grid-rowconfigure object :all :weight 1)
|
||||
(gui:grid-columnconfigure object 0 :weight 1)
|
||||
(gui:grid-columnconfigure object 1 :weight 2)))
|
||||
|
||||
(defun init-window (master main-window)
|
||||
(client-main-window:hide-autocomplete-candidates main-window)
|
||||
(gui:with-toplevel (toplevel :master master :title (_ "History window"))
|
||||
(gui:transient toplevel master)
|
||||
(let* ((screen-width-in-pixel (/ (gui:screen-width) 2))
|
||||
(frame (make-instance 'history-frame :master toplevel))
|
||||
(links-listbox (links-selection frame)))
|
||||
(gui:configure toplevel :width screen-width-in-pixel)
|
||||
(gui:grid frame 0 0 :sticky :news)
|
||||
(gui:grid-columnconfigure toplevel :all :weight 1)
|
||||
(gui:grid-rowconfigure toplevel :all :weight 1)
|
||||
(gui:bind (gui:listbox (interval-selection frame))
|
||||
#$<<ListboxSelect>>$
|
||||
(lambda (e)
|
||||
(declare (ignore e))
|
||||
(a:when-let ((selected (first (gui:listbox-get-selection-value
|
||||
(interval-selection frame)))))
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(multiple-value-bind (from to)
|
||||
(slice-label->interval selected)
|
||||
(let ((rows (comm:make-request :gemini-history-rows
|
||||
1
|
||||
from
|
||||
to)))
|
||||
(gui:listbox-delete links-listbox)
|
||||
(setf (gui-mw:data links-listbox) rows)
|
||||
(gui:listbox-append (gui:listbox links-listbox)
|
||||
(gui-mw::get-searchable-listbox-data links-listbox))))))))
|
||||
(gui:bind (gui:listbox links-listbox)
|
||||
#$<<ListboxSelect>>$
|
||||
(lambda (e)
|
||||
(declare (ignore e))
|
||||
(a:when-let ((selected (first (gui:listbox-get-selection-value
|
||||
links-listbox))))
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(client-main-window::open-iri selected main-window t))))))))
|
||||
@ -270,7 +270,11 @@
|
||||
(bookmarks (gui:make-menu bar (_ "Bookmarks")))
|
||||
(gemlogs (gui:make-menu bar (_ "Gemlogs")))
|
||||
#+gempub-support (gempub (gui:make-menu bar (_ "Books")))
|
||||
(history (gui:make-menu bar (_ "History")))
|
||||
(help (gui:make-menu bar (_ "Help"))))
|
||||
(gui:make-menubutton history
|
||||
(_ "Manage")
|
||||
(menu:manage-history-clsr main-window))
|
||||
(gui:make-menubutton tools
|
||||
(_ "Certificates")
|
||||
(menu:show-certificates-clsr main-window)
|
||||
|
||||
@ -185,3 +185,8 @@
|
||||
(fs:copy-a-file input-file-path
|
||||
output-file
|
||||
:overwrite overwrite))))))
|
||||
|
||||
(defun manage-history-clsr (main-window)
|
||||
(lambda ()
|
||||
(let ((master gui-goodies:*toplevel*))
|
||||
(client-history-window:init-window master main-window))))
|
||||
|
||||
@ -692,3 +692,13 @@
|
||||
|
||||
(defun gemini-url-needs-proxy-p (url)
|
||||
(gemini-client:url-needs-proxy-p url))
|
||||
|
||||
(defclass gemini-history (box) ())
|
||||
|
||||
(defmethod yason:encode ((object gemini-history) &optional (stream *standard-output*))
|
||||
(encode-flat-array-of-plists (unbox object) stream))
|
||||
|
||||
(defun gemini-history-rows (days-from days-to)
|
||||
(let ((rows (db:gemini-history-rows days-from days-to (ui:open-url-prompt))))
|
||||
(make-instance 'gemini-history
|
||||
:contents rows)))
|
||||
|
||||
@ -118,6 +118,10 @@
|
||||
(gen-rpc "gemini-parse-string"
|
||||
'gemini-parse-string
|
||||
"string" 0)
|
||||
(gen-rpc "gemini-history-rows"
|
||||
'gemini-history-rows
|
||||
"days-from" 0
|
||||
"days-to" 1)
|
||||
(gen-rpc "make-error-page"
|
||||
'make-error-page
|
||||
"iri" 0
|
||||
|
||||
@ -3645,7 +3645,8 @@
|
||||
:show-page-source-clsr
|
||||
:search-gempub-library-clsr
|
||||
:make-gempub-clsr
|
||||
:install-gempub-clsr))
|
||||
:install-gempub-clsr
|
||||
:manage-history-clsr))
|
||||
|
||||
(defpackage :client-certificates-window
|
||||
(:use
|
||||
@ -3791,6 +3792,26 @@
|
||||
:init-window
|
||||
:create-gempub))
|
||||
|
||||
(defpackage :client-history-window
|
||||
(:use
|
||||
:cl
|
||||
:config
|
||||
:constants
|
||||
:text-utils
|
||||
:misc-utils)
|
||||
(:local-nicknames (:cert-win :client-certificates-window)
|
||||
(:comm :json-rpc-communication)
|
||||
(:re :cl-ppcre)
|
||||
(:a :alexandria)
|
||||
(:ev :program-events)
|
||||
(:cev :client-events)
|
||||
(:gui :nodgui)
|
||||
(:gui-mw :nodgui.mw)
|
||||
(:gui-shapes :nodgui.shapes)
|
||||
(:menu :client-menu-command))
|
||||
(:export
|
||||
:init-window))
|
||||
|
||||
(defpackage :client-search-frame
|
||||
(:use
|
||||
:cl
|
||||
|
||||
@ -177,6 +177,7 @@
|
||||
(:file "bookmark-window")
|
||||
(:file "gemlog-window")
|
||||
(:file "gempub-window")
|
||||
(:file "history-window")
|
||||
(:file "menu-command")
|
||||
(:file "internal-paths")
|
||||
(:file "search-frame")
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user