diff --git a/source/browser.lisp b/source/browser.lisp index 8ea8b73138e..508b61c7de6 100644 --- a/source/browser.lisp +++ b/source/browser.lisp @@ -117,6 +117,10 @@ issued by an external program or issued by Control+ in a new window.") :reader ready-p :documentation "If non-nil, the browser is ready for operation (make buffers, load data files, open prompt buffer, etc).") + (native-dialogs t + :type boolean + :documentation "Whether to use prompt-buffer-reliant script dialogs and file-chooser. +If nil, renderer-provided dialogs are used.") (session-restore-prompt :always-ask :documentation "Ask whether to restore the session. The possible values are `:always-ask', `:always-restore' and `:never-restore'.") diff --git a/source/renderer-gtk.lisp b/source/renderer-gtk.lisp index d674bbcfecb..9a98bbc2a70 100644 --- a/source/renderer-gtk.lisp +++ b/source/renderer-gtk.lisp @@ -823,62 +823,64 @@ See `gtk-browser's `modifier-translator' slot." (gobject:g-signal-connect (gtk-object buffer) "script-dialog" (lambda (web-view dialog) (declare (ignore web-view)) - (let ((dialog (gobject:pointer dialog))) - (webkit:webkit-script-dialog-ref dialog) - (run-thread - (case (webkit:webkit-script-dialog-get-dialog-type dialog) - (:webkit-script-dialog-alert (echo (webkit:webkit-script-dialog-get-message dialog))) - (:webkit-script-dialog-prompt - (webkit:webkit-script-dialog-prompt-set-text - dialog - (first - (prompt - :input (webkit:webkit-script-dialog-prompt-get-default-text dialog) - :prompt (webkit:webkit-script-dialog-get-message dialog) - :sources (list (make-instance 'prompter:raw-source)))))) - ((:webkit-script-dialog-confirm :webkit-script-dialog-before-unload-confirm) - (webkit:webkit-script-dialog-confirm-set-confirmed - dialog (if-confirm - ((webkit:webkit-script-dialog-get-message dialog)) - t nil)))) - (webkit:webkit-script-dialog-close dialog))) - t)) + (when (native-dialogs *browser*) + (let ((dialog (gobject:pointer dialog))) + (webkit:webkit-script-dialog-ref dialog) + (run-thread + (case (webkit:webkit-script-dialog-get-dialog-type dialog) + (:webkit-script-dialog-alert (echo (webkit:webkit-script-dialog-get-message dialog))) + (:webkit-script-dialog-prompt + (webkit:webkit-script-dialog-prompt-set-text + dialog + (first + (prompt + :input (webkit:webkit-script-dialog-prompt-get-default-text dialog) + :prompt (webkit:webkit-script-dialog-get-message dialog) + :sources (list (make-instance 'prompter:raw-source)))))) + ((:webkit-script-dialog-confirm :webkit-script-dialog-before-unload-confirm) + (webkit:webkit-script-dialog-confirm-set-confirmed + dialog (if-confirm + ((webkit:webkit-script-dialog-get-message dialog)) + t nil)))) + (webkit:webkit-script-dialog-close dialog)) + t)))) (gobject:g-signal-connect (gtk-object buffer) "run-file-chooser" (lambda (web-view file-chooser-request) (declare (ignore web-view)) - (gobject:g-object-ref (gobject:pointer file-chooser-request)) - (run-thread - (let ((files (mapcar - #'namestring - (prompt :prompt (format - nil "File~@[s~*~] to input" - (webkit:webkit-file-chooser-request-select-multiple - file-chooser-request)) - :input (or - (and - (webkit:webkit-file-chooser-request-selected-files - file-chooser-request) - (first - (webkit:webkit-file-chooser-request-selected-files - file-chooser-request))) - (namestring (uiop:getcwd))) - :sources (list (make-instance 'file-source)))))) - (when files - (webkit:webkit-file-chooser-request-select-files - file-chooser-request - (cffi:foreign-alloc :string - :initial-contents (if (webkit:webkit-file-chooser-request-select-multiple - file-chooser-request) - (mapcar #'cffi:foreign-string-alloc files) - (list (cffi:foreign-string-alloc (first files)))) - :count (if (webkit:webkit-file-chooser-request-select-multiple - file-chooser-request) - (length files) - 1) - :null-terminated-p t))) - (webkit:webkit-file-chooser-request-cancel file-chooser-request))) - t)) + (when (native-dialogs *browser*) + (gobject:g-object-ref (gobject:pointer file-chooser-request)) + (run-thread + (let ((files (mapcar + #'namestring + (prompt :prompt (format + nil "File~@[s~*~] to input" + (webkit:webkit-file-chooser-request-select-multiple + file-chooser-request)) + :input (or + (and + (webkit:webkit-file-chooser-request-selected-files + file-chooser-request) + (first + (webkit:webkit-file-chooser-request-selected-files + file-chooser-request))) + (namestring (uiop:getcwd))) + :sources (list (make-instance 'file-source)))))) + (when files + (webkit:webkit-file-chooser-request-select-files + file-chooser-request + (cffi:foreign-alloc :string + :initial-contents (if (webkit:webkit-file-chooser-request-select-multiple + file-chooser-request) + (mapcar #'cffi:foreign-string-alloc files) + (list (cffi:foreign-string-alloc (first files)))) + :count (if (webkit:webkit-file-chooser-request-select-multiple + file-chooser-request) + (length files) + 1) + :null-terminated-p t))) + (webkit:webkit-file-chooser-request-cancel file-chooser-request) + t))))) ;; TLS certificate handling (gobject:g-signal-connect (gtk-object buffer) "load-failed-with-tls-errors"