From c74f5012251331e03100f2dd6481299690ac7322 Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 25 Mar 2023 16:16:39 +0100 Subject: [PATCH] - [GUI] improved certificates window; - added midding icons file. --- data/icons/fmw_document-add.png | Bin 0 -> 1363 bytes data/icons/fmw_document-delete.png | Bin 0 -> 1335 bytes data/icons/fmw_folder.png | Bin 0 -> 1086 bytes src/gui/client/certificates-window.lisp | 165 ++++++++++++++++++++---- src/gui/client/icons.lisp | 9 +- src/package.lisp | 3 +- 6 files changed, 149 insertions(+), 28 deletions(-) create mode 100644 data/icons/fmw_document-add.png create mode 100644 data/icons/fmw_document-delete.png create mode 100644 data/icons/fmw_folder.png diff --git a/data/icons/fmw_document-add.png b/data/icons/fmw_document-add.png new file mode 100644 index 0000000000000000000000000000000000000000..bc3e615b8c52cb1356f73cf6c6b5c6a86888f9e5 GIT binary patch literal 1363 zcmV-Z1+4msP)j^|bsiW$gn|f_#0YsXO22yBLo6O>hrYA{}DWoQ-xba{DJ93`D zsq)+nj;e;c@j%1?kjeE{#b{{`g+#@59Yo#Uyi8~H@*pAr4BpE$Gr?#pq7#C`A>m1v z9a%01g<~3p6ps3R`I&1DHx4WXLW$|183_V1Gb>0VYxsU&!A7u(Gl;w>9)?01F?}Jv zp8h#W#^VAIGcpT6v=AxwjeGFZp64}LtOY}we^pZ+keM|A66p?3&Emo2tTy|I1N4~Y zWu+~f))w)Aq`8$@%7ZM%2%Up^cuqE+2ydC0KgHc1=bDIN0P~VHjTtueTXJ9TWg&IR*cJJSXC6<>TkuFYn8av z-3}u`+Ndx;>(~lbj_l4~F|v>zOLD-paoGk3S*dN_kJhfAQIxwIdkVgW!|v2{W_=#q z?!SuWlv@|qZJzm|sR{?9%k+{QFt-a*kU++dHSEOg`wci$_6-Im$yjeShNnE5PI{6P zTQW-U;jS9gHh%ivwj&Q&Q#B44Af(tlAcgC_yu8?C8Frh3uKqT3{L_GnonPYbzT>#+ z{tb`39-JuVnv8j;aoK$m7w#Uxfx=3prX;=l%10jGmB><{IgUfM*VxCC#?evvO zl;ppIn}ffQv3`w!(KHhGqHomW#*O4|$e6kc8K$u7M5^c$d8g$Eqsv9d5#Xf<9hNb!o0jW{4? zH$2m!?G2B=70aFzMRR?hv@i^LuNk(~MM=mapZF_4d_@eWe0_6!!(~Yu){Rb6N^A<{ zdMRBVLP*mK?~2F0Llh3+v%eVp)Gvxjv?#{jO<`+h3wbIh1DU!+Fe}REc)CdC31K^bTWXj<`ll@}*WNI@Z zh)Vfic41ROF*-Wyk(Wy#RPBg>qwOr>0Rce7s=Whv)Q_`W4Y)`>UTqZpY?w;-8(pvO zE#Lv4wSys-crYOG7xPXQu6+tc*_$Z)rPIvxsRf7+LqkA!54qos^Q~W@lDhAaOp3P+ z03spRyK)I-gauIx9FpOuG$steCW@;N!e_aAQdUBP!f&1j<@u|=OSQn3NRV4<`E z09=1ZB$hOibtFkq2UKBbiiD^Nq9CTDi%~Ry)i$Q5SBIWtqE84uJ?8#}<@kRA1^|%! V;(%e_uKxf4002ovPDHLkV1hP^g#`cr literal 0 HcmV?d00001 diff --git a/data/icons/fmw_document-delete.png b/data/icons/fmw_document-delete.png new file mode 100644 index 0000000000000000000000000000000000000000..c7c33ddc95d4e905621bee893ea31aa2b1153a47 GIT binary patch literal 1335 zcmV-71<3k|P)r00_x!NSr~1-Vpp?`*ZX+>i9(gfJT<@-P6Wm$Jx#S!@Iw}Uf^-6U$(C9 znB_p@UpK+%N?vgUUZ?Ahb%kL2zK8L7HBP*|sjAwjKR)rvv(M9%mTnJjU7786iJmCr zPT7IP*4aC8blx7tllSKnh>B{@!Bbc1sp1qsd?>V$OuH%)ODpC&&f_Nd-6}5h4Wn{h z0ZzR5Xuxyu$DVW`k^o5L`b@BFOg+}(V2)v2nq+s zJw6v!`aBelF>Ir7G}LS?%B?+peJ&7k(gU(c5Rf@JK_*#a_cawIV6UA-{6#UT>n1V7 zx{*)+yd2QpGlHQ?4qwHR;s4y!7kM((F|ke7L5iE45j zt1n$d?^I7~OP>G8mh+eQB$nwpIp9dYB$>*u?cay!??0pL(EEsXUBcM$BZv<4#T4WR z;4Oaw8(w`A9bX=PrDY@7mftS#wn6aZJiuf1UP>cWie(qMy}cb1=bG`r-q$hNcnp(g z8iCOf$X=f*;(oHF0h1@cMd_~H$nyJlef`jy3Y#HG08|2?$`V{s8X?!aD9pjH>QG#@ z6Oq0dq-EMGI0jGIW#63OJZe2(C+$r3BPIl8D^S&~?;}NjlZX2GOl7uY&OIv?pAVotG8Uk0`=_{vLLu$r+FdMGsA#mof2;&oheQp-fQ6NzAI(>4qT zdyu!H0GjGH4M;%&(_37UF&G-gov7As6D1BnvC8l>>jRl(!rFImp=t{XivpB}UC_xZ zDI7qNiXFKBC>gf&hdvVooB_Zq86(-XKV?Nk`{byZU}oWnxR&9K)mx!-{EE`Dhl!ia z3Xfqaw+K!9wsl-Y*PXG(!~fi9rKt&X-ugE5(|xh%tQS}arDLUc?=4wTu)U=CKIG-) zk!hA~#EHSdL3H)>;!1F&siyt!1Hus`BO(ko0LAKB)diM+7fEi-s{F^F3M}8VT$VN% z3Cy}3)&6Yk3x4rUZ~rg!SG4HEb}F_3EVBJDKSqTCxg=yh?n?MT6^cel21$Y>V~NFR tsQ}oJ5ByCzyNxq)1%BLWhMXs002ovPDHLkV1l?uc}D;M literal 0 HcmV?d00001 diff --git a/data/icons/fmw_folder.png b/data/icons/fmw_folder.png new file mode 100644 index 0000000000000000000000000000000000000000..f37bb3efebe42b1ac7b96c552f115d5a07e58180 GIT binary patch literal 1086 zcmV-E1i|}>P)hPdN^ks^x1!O4u;Z4-8&9zz0@X08Gvobnu-YeZg(HuM%xw8uWU( zg1JYxege;5=x7fB6(%kQMq=)wc-SNq^N%4N;-ms&P)ZAjVGkKE`r+|A5> zuY)#vfZc8;n}an!i`^d|BVctC#(`z&$vc5ER1zhXEw{S}vGO^fMcb6e&=GbO~jqKK{C46F19V@E?e zu|0pt*m@K*S1@#X^lMFjV<(h0a(`t=|2Beg_$hd;`9Eg6Sbq_Tvs$YtWFMA?)5Rw~ z13m!Z7C4HJbLf8~L1iYrjwr&quQ<#;j;Yi=q$g(2``Ozy0J^r-T%N~m1syMM;`edJ z4l8@#Gm$R(>k6*k&!1VyzJY<#qb$~L>2Xgmy1}O(q3AEnPPe3sV@V8sH}dm>{&fae z%ah3zUg~>=t69blGkcCmCuY)r;&HzGgBu`lDXB@2Po~lPHrsQV=F^D79Hf6Hox-hT z>71Xv3KsN+-%jowl~7#{uVs#RaR~S3%LHk|!oZPBySU5*J)i-+$l1pk5103*Mv&)B zaZY=ExekDrKxodR&-gDu#n-=z|I-l9|D3KifPV!T0RL}b>2q6X2><{907*qoM6N<$ Ef?F#E#sB~S literal 0 HcmV?d00001 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