cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [GUI] improved certificates window; 

- added midding icons file.
This commit is contained in:
cage 2023-03-25 16:16:39 +01:00
parent 1e658fbe6c
commit c74f501225
6 changed files with 149 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
data/icons/fmw_document-add.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
data/icons/fmw_document-delete.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
data/icons/fmw_folder.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

165
src/gui/client/certificates-window.lisp
View File

@ -59,31 +59,145 @@
(let ((new-rows (all-rows))) (let ((new-rows (all-rows)))
(resync-rows certificate-frame new-rows))))))) (resync-rows certificate-frame new-rows)))))))
(defun import-certificates-clsr (certificate-frame) (defclass import-window (gui:frame)
((url-entry
:initform nil
:initarg :url-entry
:accessor url-entry)
(certificate-entry
:initform nil
:initarg :certificate-entry
:accessor certificate-entry)
(certificate-choose-button
:initform nil
:initarg :certificate-choose-button
:accessor certificate-choose-button)
(key-entry
:initform nil
:initarg :key-entry
:accessor key-entry)
(key-choose-button
:initform nil
:initarg :key-choose-button
:accessor key-choose-button)
(ok-button
:initform nil
:initarg :ok-button
:accessor ok-button)
(cancel-button
:initform nil
:initarg :cancel-button
:accessor cancel-button)))
(defun autocomplete-file-cb ()
(lambda (hint)
(let ((match-results (complete:directory-complete hint)))
(values match-results nil))))
(defun on-file-choosen-clsr (entry parent &optional (initial-dir nil))
(lambda () (lambda ()
(a:when-let* ((uri (gui-mw:text-input-dialog certificate-frame (when (gui:text (certificate-entry parent))
(_ "Information") (setf initial-dir (fs:parent-dir-path (gui:text (certificate-entry parent)))))
(_ "Type the net address the certificate is valid for:") (let ((file-path (gui:get-open-file :initial-dir initial-dir
:text (strcat gemini-constants:+gemini-scheme+ "://"))) :parent parent
(cert-file (gui:get-open-file :initial-dir "." :multiple nil
:parent certificate-frame :title (_ "Choose the file"))))
:multiple nil (setf (gui:text entry) file-path))))
:title (_ "Choose the certificate file")))
(key-file (gui:get-open-file :initial-dir (fs:parent-dir-path cert-file) (defun import-certificate-clsr (import-window certificate-frame)
:parent certificate-frame (lambda ()
:multiple nil (with-accessors ((url-entry url-entry)
:title (_ "Choose the private key file")))) (certificate-entry certificate-entry)
(handler-case (key-entry key-entry)) import-window
(progn (a:when-let* ((uri (gui:text url-entry))
(cev:enqueue-request-and-wait-results :gemini-import-certificate (cert-file (gui:text certificate-entry))
1 (key-file (gui:text key-entry)))
ev:+standard-event-priority+ (handler-case
uri (progn
cert-file (cev:enqueue-request-and-wait-results :gemini-import-certificate
key-file) 1
(resync-rows certificate-frame (all-rows))) ev:+standard-event-priority+
(error (e) uri
(client-main-window::notify-request-error e)))))) cert-file
key-file)
(resync-rows certificate-frame (all-rows))
(gui:break-mainloop))
(error (e)
(client-main-window::notify-request-error e)))))))
(defmethod initialize-instance :after ((object import-window) &key (certificate-frame nil)
&allow-other-keys)
(with-accessors ((url-entry url-entry)
(certificate-entry certificate-entry)
(key-entry key-entry)
(certificate-choose-button certificate-choose-button)
(key-choose-button key-choose-button)
(ok-button ok-button)
(cancel-button cancel-button)) object
(setf url-entry (make-instance 'gui:entry
:master object
:text (strcat gemini-constants:+gemini-scheme+ "://")))
(setf certificate-entry
(make-instance 'gui-mw:autocomplete-entry
:master object
:autocomplete-function (autocomplete-file-cb)))
(setf key-entry
(make-instance 'gui-mw:autocomplete-entry
:master object
:autocomplete-function (autocomplete-file-cb)))
(let ((inner-entry-certificate (gui-mw:autocomplete-entry-widget certificate-entry))
(inner-entry-key (gui-mw:autocomplete-entry-widget key-entry))
(url-label (make-instance 'gui:label
:master object
:text "Gemini address"))
(cert-label (make-instance 'gui:label
:master object
:text "Certificate file"))
(key-label (make-instance 'gui:label
:master object
:text "Key file"))
(buttons-frame (make-instance 'gui:frame
:master object)))
(setf certificate-choose-button
(make-instance 'gui:button
:image icons:*folder*
:master object
:command
(on-file-choosen-clsr inner-entry-certificate object ".")))
(setf key-choose-button
(make-instance 'gui:button
:image icons:*folder*
:master object
:command (on-file-choosen-clsr inner-entry-key object)))
(setf ok-button (make-instance 'gui:button
:text "OK"
:master buttons-frame
:command
(import-certificate-clsr object certificate-frame)))
(setf cancel-button (make-instance 'gui:button
:text (_ "Cancel")
:master buttons-frame
:command (lambda () (gui:break-mainloop))))
(gui:grid url-label 0 0)
(gui:grid url-entry 1 0)
(gui:grid cert-label 3 0)
(gui:grid certificate-entry 4 0)
(gui:grid certificate-choose-button 4 1)
(gui:grid key-label 5 0)
(gui:grid key-entry 6 0)
(gui:grid key-choose-button 6 1)
(gui:grid buttons-frame 7 0)
(gui:grid ok-button 0 0)
(gui:grid cancel-button 0 1))))
(defun make-import-certificates-win-clsr (certificate-frame master)
(lambda ()
(gui:with-modal-toplevel (toplevel :master master :title (_ "Import certificates"))
(gui:transient toplevel master)
(let ((frame (make-instance 'import-window
:certificate-frame certificate-frame
:master toplevel)))
(gui:grid frame 0 0 :sticky :news)))))
(defun init-window (master) (defun init-window (master)
(gui:with-modal-toplevel (toplevel :master master :title (_ "Certificates")) (gui:with-modal-toplevel (toplevel :master master :title (_ "Certificates"))
@ -97,7 +211,8 @@
(import-button (make-instance 'gui:button (import-button (make-instance 'gui:button
:master buttons-frame :master buttons-frame
:image icons:*document-add* :image icons:*document-add*
:command (import-certificates-clsr table)))) :command
(make-import-certificates-win-clsr table toplevel))))
(gui-goodies:attach-tooltips (delete-button (_ "delete selected certificates")) (gui-goodies:attach-tooltips (delete-button (_ "delete selected certificates"))
(import-button (_ "import certificate form disk"))) (import-button (_ "import certificate form disk")))
(gui:grid table 0 0 :sticky :nwe) (gui:grid table 0 0 :sticky :nwe)

9
src/gui/client/icons.lisp
View File

@ -16,7 +16,9 @@
(a:define-constant +document-delete+ "fmw_document-delete" :test #'string=) (a:define-constant +document-delete+ "fmw_document-delete" :test #'string=)
(a:define-constant +document-add+ "fmw_document-add" :test #'string=) (a:define-constant +document-add+ "fmw_document-add" :test #'string=)
(a:define-constant +folder+ "fmw_folder" :test #'string=)
(defparameter *search* nil) (defparameter *search* nil)
@ -34,6 +36,8 @@
(defparameter *document-add* nil) (defparameter *document-add* nil)
(defparameter *folder* nil)
(defun load-icon (filename) (defun load-icon (filename)
(let ((path (if (not (re:scan "(?i)png$" filename)) (let ((path (if (not (re:scan "(?i)png$" filename))
(res:get-data-file (fs:cat-parent-dir +icon-dir+ (res:get-data-file (fs:cat-parent-dir +icon-dir+
@ -51,4 +55,5 @@
(setf *refresh* (load-icon +refresh+)) (setf *refresh* (load-icon +refresh+))
(setf *up* (load-icon +up+)) (setf *up* (load-icon +up+))
(setf *document-delete* (load-icon +document-delete+)) (setf *document-delete* (load-icon +document-delete+))
(setf *document-add* (load-icon +document-add+))) (setf *document-add* (load-icon +document-add+))
(setf *folder* (load-icon +folder+)))

3
src/package.lisp
View File

@ -3320,7 +3320,8 @@
:*refresh* :*refresh*
:*up* :*up*
:*document-delete* :*document-delete*
:*document-add*)) :*document-add*
:*folder*))
(defpackage :validation (defpackage :validation
(:use (:use