diff --git a/data/icons/fmw_document-add.png b/data/icons/fmw_document-add.png new file mode 100644 index 0000000..bc3e615 Binary files /dev/null and b/data/icons/fmw_document-add.png differ diff --git a/data/icons/fmw_document-delete.png b/data/icons/fmw_document-delete.png new file mode 100644 index 0000000..c7c33dd Binary files /dev/null and b/data/icons/fmw_document-delete.png differ diff --git a/data/icons/fmw_folder.png b/data/icons/fmw_folder.png new file mode 100644 index 0000000..f37bb3e Binary files /dev/null and b/data/icons/fmw_folder.png differ diff --git a/src/gui/client/certificates-window.lisp b/src/gui/client/certificates-window.lisp index 483772b..e040f81 100644 --- a/src/gui/client/certificates-window.lisp +++ b/src/gui/client/certificates-window.lisp @@ -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) diff --git a/src/gui/client/icons.lisp b/src/gui/client/icons.lisp index f27bb84..cfc18bf 100644 --- a/src/gui/client/icons.lisp +++ b/src/gui/client/icons.lisp @@ -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+))) diff --git a/src/package.lisp b/src/package.lisp index ac12f2b..175107b 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3320,7 +3320,8 @@ :*refresh* :*up* :*document-delete* - :*document-add*)) + :*document-add* + :*folder*)) (defpackage :validation (:use