mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-02 04:36:43 +01:00
- [GUI] improved certificates window;
- added midding icons file.
This commit is contained in:
cage
parent
1e658fbe6c
commit
c74f501225
BIN
data/icons/fmw_document-add.png
Normal file
BIN
data/icons/fmw_document-add.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.3 KiB |
BIN
data/icons/fmw_document-delete.png
Normal file
BIN
data/icons/fmw_document-delete.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.3 KiB |
BIN
data/icons/fmw_folder.png
Normal file
BIN
data/icons/fmw_folder.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.1 KiB |
@ -59,31 +59,145 @@
|
||||
(let ((new-rows (all-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 ()
|
||||
(a:when-let* ((uri (gui-mw:text-input-dialog certificate-frame
|
||||
(_ "Information")
|
||||
(_ "Type the net address the certificate is valid for:")
|
||||
:text (strcat gemini-constants:+gemini-scheme+ "://")))
|
||||
(cert-file (gui:get-open-file :initial-dir "."
|
||||
:parent certificate-frame
|
||||
:multiple nil
|
||||
:title (_ "Choose the certificate file")))
|
||||
(key-file (gui:get-open-file :initial-dir (fs:parent-dir-path cert-file)
|
||||
:parent certificate-frame
|
||||
:multiple nil
|
||||
:title (_ "Choose the private key file"))))
|
||||
(handler-case
|
||||
(progn
|
||||
(cev:enqueue-request-and-wait-results :gemini-import-certificate
|
||||
1
|
||||
ev:+standard-event-priority+
|
||||
uri
|
||||
cert-file
|
||||
key-file)
|
||||
(resync-rows certificate-frame (all-rows)))
|
||||
(error (e)
|
||||
(client-main-window::notify-request-error e))))))
|
||||
(when (gui:text (certificate-entry parent))
|
||||
(setf initial-dir (fs:parent-dir-path (gui:text (certificate-entry parent)))))
|
||||
(let ((file-path (gui:get-open-file :initial-dir initial-dir
|
||||
:parent parent
|
||||
:multiple nil
|
||||
:title (_ "Choose the file"))))
|
||||
(setf (gui:text entry) file-path))))
|
||||
|
||||
(defun import-certificate-clsr (import-window certificate-frame)
|
||||
(lambda ()
|
||||
(with-accessors ((url-entry url-entry)
|
||||
(certificate-entry certificate-entry)
|
||||
(key-entry key-entry)) import-window
|
||||
(a:when-let* ((uri (gui:text url-entry))
|
||||
(cert-file (gui:text certificate-entry))
|
||||
(key-file (gui:text key-entry)))
|
||||
(handler-case
|
||||
(progn
|
||||
(cev:enqueue-request-and-wait-results :gemini-import-certificate
|
||||
1
|
||||
ev:+standard-event-priority+
|
||||
uri
|
||||
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)
|
||||
(gui:with-modal-toplevel (toplevel :master master :title (_ "Certificates"))
|
||||
@ -97,7 +211,8 @@
|
||||
(import-button (make-instance 'gui:button
|
||||
:master buttons-frame
|
||||
: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"))
|
||||
(import-button (_ "import certificate form disk")))
|
||||
(gui:grid table 0 0 :sticky :nwe)
|
||||
|
||||
@ -16,7 +16,9 @@
|
||||
|
||||
(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)
|
||||
|
||||
@ -34,6 +36,8 @@
|
||||
|
||||
(defparameter *document-add* nil)
|
||||
|
||||
(defparameter *folder* nil)
|
||||
|
||||
(defun load-icon (filename)
|
||||
(let ((path (if (not (re:scan "(?i)png$" filename))
|
||||
(res:get-data-file (fs:cat-parent-dir +icon-dir+
|
||||
@ -51,4 +55,5 @@
|
||||
(setf *refresh* (load-icon +refresh+))
|
||||
(setf *up* (load-icon +up+))
|
||||
(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+)))
|
||||
|
||||
@ -3320,7 +3320,8 @@
|
||||
:*refresh*
|
||||
:*up*
|
||||
:*document-delete*
|
||||
:*document-add*))
|
||||
:*document-add*
|
||||
:*folder*))
|
||||
|
||||
(defpackage :validation
|
||||
(:use
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user