(in-package :client-certificates-window) (named-readtables:in-readtable nodgui.syntax:nodgui-syntax) (defclass certificate-frame (gui-goodies:table-frame) ()) (defun resync-rows (certificate-frame new-rows) (with-accessors ((tree gui-goodies:tree) (rows gui-goodies:rows)) certificate-frame (gui:treeview-delete-all tree) (setf rows new-rows) (loop for row in rows do (let* ((tree-row (make-instance 'gui:tree-item :id (db:row-cache-key row) :text (db:row-cache-key row) :column-values (list (getf row :file) (getf row :hash)) :index gui:+treeview-last-index+))) (gui:treeview-insert-item tree :item tree-row)))) (gui:treeview-refit-columns-width (gui-goodies:tree certificate-frame)) certificate-frame) (defun all-rows () (cev:enqueue-request-and-wait-results :gemini-certificates 1 ev:+standard-event-priority+)) (defmethod initialize-instance :after ((object certificate-frame) &key &allow-other-keys) (with-accessors ((tree gui-goodies:tree) (rows gui-goodies:rows)) object (let ((new-rows (all-rows)) (treeview (make-instance 'gui:scrolled-treeview :master object :pack '(:side :top :expand t :fill :both) :columns (list (_ "File") (_ "Fingerprint"))))) (setf tree treeview) (gui:treeview-heading tree gui:+treeview-first-column-id+ :text (_ "Address")) (resync-rows object new-rows) object))) (defun delete-certificates-clsr (certificate-frame) (lambda () (a:when-let* ((selections (gui:treeview-get-selection (gui-goodies:tree certificate-frame)))) (loop for selection in selections do (let ((url (gui:id selection))) (ev:with-enqueued-process-and-unblock () (comm:make-request :gemini-delete-certificate 1 url)) (let ((new-rows (all-rows))) (resync-rows certificate-frame new-rows))))))) (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 () (when (string-not-empty-p (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+ "://"))) (let* ((screen-width-in-pixel (/ (gui:screen-width) 2)) (font (gui:cget url-entry :font)) (zero-char-width (gui:font-measure font "0")) (entries-width (truncate (/ screen-width-in-pixel zero-char-width)))) (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))) (gui:configure url-entry :width entries-width) (gui:configure certificate-entry :width entries-width) (gui:configure key-entry :width entries-width) (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")) (gui:transient toplevel master) (let* ((table (make-instance 'certificate-frame :master toplevel)) (buttons-frame (make-instance 'gui:frame :master toplevel)) (delete-button (make-instance 'gui:button :master buttons-frame :image icons:*document-delete* :command (delete-certificates-clsr table))) (import-button (make-instance 'gui:button :master buttons-frame :image icons:*document-add* :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) (gui:grid buttons-frame 1 0 :sticky :s) (gui:grid delete-button 0 0 :sticky :s) (gui:grid import-button 0 1 :sticky :s))))