From b73c0856f2ae5e16a5093f4c239c29f666fec72a Mon Sep 17 00:00:00 2001 From: cage Date: Fri, 12 May 2023 14:04:08 +0200 Subject: [PATCH] - [GUI] started adding feature to inline bitmaps. --- src/gui/client/main-window.lisp | 137 ++++++++++++++++++++++++-------- 1 file changed, 103 insertions(+), 34 deletions(-) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index e21a585..fc7e54f 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -318,40 +318,106 @@ path query)))) +(defun slurp-iri (main-window iri) + (let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request + 1 + ev:+maximum-event-priority+ + iri + t))) + (multiple-value-bind (status-code + status-description + meta + cached + original-iri) + (displace-gemini-response connecting-response) + (declare (ignore original-iri cached)) + (cond + ((gemini-client:header-input-p status-code) + (let ((actual-iri (get-user-request-query iri meta main-window))) + (slurp-iri main-window actual-iri))) + ((gemini-client:header-sensitive-input-p status-code) + (let ((actual-iri (get-user-request-query iri meta main-window :sensitive t))) + (slurp-iri main-window actual-iri))) + ((= status-code comm:+tofu-error-status-code+) + (when (gui:ask-yesno meta + :title (_ "Server certificate error") + :parent main-window) + (cev:enqueue-request-and-wait-results :gemini-delete-certificate + 1 + ev:+maximum-event-priority+ + iri) + (slurp-iri main-window iri))) + ((or (gemini-client:header-temporary-failure-p status-code) + (gemini-client:header-permanent-failure-p status-code) + (gemini-client:header-certificate-failure-p status-code)) + (notify-request-error (format nil + "Error getting ~a (~a ~a)" + iri + status-code + status-description))) + ((gemini-client:header-redirect-p status-code) + (when (gui:ask-yesno (format nil (_ "Follow redirection to ~a?") meta) + :title (_ "Redirection") + :parent main-window) + (let ((redirect-iri (if (iri:absolute-url-p meta) + meta + (absolutize-link iri meta)))) + (slurp-iri redirect-iri main-window)))) + ((gemini-client:header-success-p status-code) + (slurp-non-text-data main-window iri :try-to-open nil)))))) + (defun contextual-menu-link-clrs (link-name link-value main-window) - (flet ((add-to-tour-callback () - (ev:with-enqueued-process-and-unblock () - (comm:make-request :tour-add-link - 1 - link-value - link-name))) - (download-background-callback () - (open-iri link-value main-window nil :status +stream-status-downloading+)) - (copy-link-callback () - (os-utils:copy-to-clipboard link-value) - (print-info-message (format nil - (_ "~s has been copied to the clipboard") - link-value))) - (bookmark-link-callback () - (let ((bookmarkedp (cev:enqueue-request-and-wait-results :gemini-bookmarked-p - 1 - ev:+standard-event-priority+ - link-value))) - (if bookmarkedp - (print-info-message (format nil - (_ "~s already bookmarked") - link-value) - :bold t) - (client-bookmark-window:init-window main-window link-value))))) + (labels ((add-to-tour-callback () + (ev:with-enqueued-process-and-unblock () + (comm:make-request :tour-add-link + 1 + link-value + link-name))) + (download-background-callback () + (open-iri link-value main-window nil :status +stream-status-downloading+)) + (copy-link-callback () + (os-utils:copy-to-clipboard link-value) + (print-info-message (format nil + (_ "~s has been copied to the clipboard") + link-value))) + (bookmark-link-callback () + (let ((bookmarkedp (cev:enqueue-request-and-wait-results :gemini-bookmarked-p + 1 + ev:+standard-event-priority+ + link-value))) + (if bookmarkedp + (print-info-message (format nil + (_ "~s already bookmarked") + link-value) + :bold t) + (client-bookmark-window:init-window main-window link-value)))) + (inline-possible-p () + (or (re:scan "(?i)jpg$" link-value) + (re:scan "(?i)jpeg$" link-value) + (re:scan "(?i)png$" link-value) + (re:scan "(?i)gif$" link-value) + (re:scan "(?i)bmp$" link-value) + (re:scan "(?i)tga$" link-value))) + (open-inline-clsr (x y) + (lambda () + (if (inline-possible-p) + (let* ((file-path (slurp-iri main-window link-value)) + (image (gui:make-image file-path)) + (coordinates `(+ (:x ,x :y ,y) 1 :lines))) + (gui:insert-image (gemtext-widget main-window) image coordinates)) + (funcall (link-click-mouse-1-callback-clsr link-value main-window)))))) (lambda () - (let* ((popup-menu (gui:make-menu nil (_"link menu")))) + (let* ((popup-menu (gui:make-menu nil (_"link menu"))) + (x (gui:screen-mouse-x)) + (y (gui:screen-mouse-y))) + (gui:make-menubutton popup-menu (_ "Inline") (open-inline-clsr x y)) (gui:make-menubutton popup-menu (_ "Add link to bookmarks") #'bookmark-link-callback) (gui:make-menubutton popup-menu (_ "Add link to tour") #'add-to-tour-callback) (gui:make-menubutton popup-menu (_ "Copy link to the clipboard") #'copy-link-callback) (gui:make-menubutton popup-menu (_ "Open link in background") #'download-background-callback) - (gui:popup popup-menu (gui:screen-mouse-x) (gui:screen-mouse-y)))))) + (gui:popup popup-menu x y))))) (defun collect-ir-lines (request-iri main-window lines) (with-accessors ((ir-lines ir-lines) @@ -630,13 +696,15 @@ (maybe-open-if-completed stream-info support-file)))) (wait-enough-data))) -(defun slurp-non-text-data (main-window iri) - (labels ((maybe-open-if-completed (stream-info support-file) +(defun slurp-non-text-data (main-window iri &key (try-to-open t)) + (labels ((wait-until-download-complete (stream-info support-file) (if (string-equal (getf stream-info :stream-status) :completed) - (client-os-utils:open-resource-with-external-program main-window support-file) + (if try-to-open + (client-os-utils:open-resource-with-external-program main-window support-file) + (getf stream-info :support-file)) (wait-enough-data))) - (buffer-filled-enough--to-open-p (buffer-size read-so-far) + (buffer-filled-enough-to-open-p (buffer-size read-so-far) (let ((filled-configuration-threshold (and buffer-size (> read-so-far buffer-size)))) (or filled-configuration-threshold @@ -654,14 +722,15 @@ (swconf:link-regex->program-to-use support-file) (declare (ignore y)) (if program-exists - (if wait-for-download - (maybe-open-if-completed stream-info support-file) + (if (or wait-for-download + (not try-to-open)) + (wait-until-download-complete stream-info support-file) (let ((buffer-size (swconf:link-regex->program-to-use-buffer-size support-file))) - (if (buffer-filled-enough--to-open-p buffer-size read-so-far) + (if (buffer-filled-enough-to-open-p buffer-size read-so-far) (client-os-utils:open-resource-with-external-program main-window support-file) (wait-enough-data)))) - (maybe-open-if-completed stream-info support-file)))))) + (wait-until-download-complete stream-info support-file)))))) (wait-enough-data))) (defun start-stream-iri (iri main-window use-cache &optional (status +stream-status-streaming+))