From b1440cd2186af476df8eda73e5fc5a501935c8d0 Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 13 May 2023 14:45:45 +0200 Subject: [PATCH] - [GUI] added command to inline all images in a page. --- src/gui/client/icons.lisp | 49 +++++---- src/gui/client/main-window.lisp | 178 +++++++++++++++++++------------- src/package.lisp | 3 +- 3 files changed, 135 insertions(+), 95 deletions(-) diff --git a/src/gui/client/icons.lisp b/src/gui/client/icons.lisp index d80ac9f..d9accaa 100644 --- a/src/gui/client/icons.lisp +++ b/src/gui/client/icons.lisp @@ -1,46 +1,48 @@ (in-package :icons) -(a:define-constant +icon-dir+ "/data/icons/" :test #'string=) +(a:define-constant +icon-dir+ "/data/icons/" :test #'string=) -(a:define-constant +search+ "fmw_search" :test #'string=) +(a:define-constant +search+ "fmw_search" :test #'string=) -(a:define-constant +back+ "fmw_back" :test #'string=) +(a:define-constant +back+ "fmw_back" :test #'string=) -(a:define-constant +go+ "fmw_go" :test #'string=) +(a:define-constant +go+ "fmw_go" :test #'string=) -(a:define-constant +open-tour+ "fmw_open_tour" :test #'string=) +(a:define-constant +open-tour+ "fmw_open_tour" :test #'string=) -(a:define-constant +refresh+ "fmw_refresh" :test #'string=) +(a:define-constant +refresh+ "fmw_refresh" :test #'string=) -(a:define-constant +up+ "fmw_uparrow" :test #'string=) +(a:define-constant +up+ "fmw_uparrow" :test #'string=) -(a:define-constant +document-delete+ "fmw_document-delete" :test #'string=) +(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 +document-accept+ "fmw_document-accept" :test #'string=) +(a:define-constant +document-accept+ "fmw_document-accept" :test #'string=) -(a:define-constant +document-edit+ "fmw_document-edit" :test #'string=) +(a:define-constant +document-edit+ "fmw_document-edit" :test #'string=) -(a:define-constant +folder+ "fmw_folder" :test #'string=) +(a:define-constant +folder+ "fmw_folder" :test #'string=) -(a:define-constant +star-yellow+ "fmw_star-yellow.png" :test #'string=) +(a:define-constant +star-yellow+ "fmw_star-yellow.png" :test #'string=) -(a:define-constant +star-blue+ "fmw_star-blue.png" :test #'string=) +(a:define-constant +star-blue+ "fmw_star-blue.png" :test #'string=) -(a:define-constant +arrow-up+ "fmw_arrow-up" :test #'string=) +(a:define-constant +arrow-up+ "fmw_arrow-up" :test #'string=) -(a:define-constant +arrow-down+ "fmw_arrow-down" :test #'string=) +(a:define-constant +arrow-down+ "fmw_arrow-down" :test #'string=) -(a:define-constant +cross+ "fmw_cross" :test #'string=) +(a:define-constant +cross+ "fmw_cross" :test #'string=) -(a:define-constant +bus-go+ "fmw_bus-go" :test #'string=) +(a:define-constant +bus-go+ "fmw_bus-go" :test #'string=) -(a:define-constant +dice+ "fmw_dice" :test #'string=) +(a:define-constant +dice+ "fmw_dice" :test #'string=) -(a:define-constant +gemlog-subscribe+ "fmw_rss-add.png" :test #'string=) +(a:define-constant +gemlog-subscribe+ "fmw_rss-add.png" :test #'string=) -(a:define-constant +gemlog-unsubscribe+ "fmw_rss-delete.png" :test #'string=) +(a:define-constant +gemlog-unsubscribe+ "fmw_rss-delete.png" :test #'string=) + +(a:define-constant +inline-images+ "fmw_two-pictures.png" :test #'string=) (defparameter *search* nil) @@ -82,6 +84,8 @@ (defparameter *gemlog-unsubscribe* nil) +(defparameter *inline-images* nil) + (defun load-icon (filename) (let ((path (if (not (re:scan "(?i)png$" filename)) (res:get-data-file (fs:cat-parent-dir +icon-dir+ @@ -111,4 +115,5 @@ (setf *bus-go* (load-icon +bus-go+)) (setf *dice* (load-icon +dice+)) (setf *gemlog-subscribe* (load-icon +gemlog-subscribe+)) - (setf *gemlog-unsubscribe* (load-icon +gemlog-unsubscribe+))) + (setf *gemlog-unsubscribe* (load-icon +gemlog-unsubscribe+)) + (setf *inline-images* (load-icon +inline-images+))) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index 2f6bb0c..4b88de8 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -263,7 +263,11 @@ (subscribe-button :initform nil :initarg :subscribe-button - :accessor subscribe-button))) + :accessor subscribe-button) + (inline-images-button + :initform nil + :initarg :inline-images-button + :accessor inline-images-button))) (defun autocomplete-iri-clsr (toolbar) (declare (ignore toolbar)) @@ -368,6 +372,55 @@ (comm:make-request :gemini-save-url-db-history 1 iri)) (slurp-non-text-data main-window iri :try-to-open nil)))))) +(defun inline-image-p (link-value) + (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))) + +(defun inline-possible-p (link-value) + (inline-image-p link-value)) + +(defun inline-type (link-value) + (when (inline-image-p link-value) + :inline-image)) + +(defun inline-image (main-window link-value line-index) + (let* ((file-path (slurp-iri main-window link-value)) + (image (gui:make-image file-path)) + (coordinates `(+ (:line ,line-index :char 0) 1 :lines))) + (gui:insert-image (gemtext-widget main-window) image coordinates) + (with-accessors ((ir-lines ir-lines) + (ir-rendered-lines ir-rendered-lines)) main-window + (let* ((parent-line (elt ir-lines (- line-index 1))) + (new-line (copy-list parent-line))) + (setf (getf new-line :type) (inline-type link-value)) + (setf ir-lines + (fresh-vector-insert@ ir-lines + new-line + line-index)) + (setf ir-rendered-lines + (fresh-vector-insert@ ir-lines + "" + line-index)))))) + +(defun inline-all-images (main-window) + (gui-goodies:with-busy* (main-window) + (loop for line across (ir-lines main-window) + for line-number from 1 + when (and (string= (getf line :type) "a") + (inline-image-p (getf line :href))) + do + (let ((link-value (absolutize-link (get-address-bar-text main-window) + (getf line :href)))) + (inline-image main-window link-value line-number))))) + +(defun inline-all-images-clsr (main-window) + (lambda () + (inline-all-images main-window))) + (defun contextual-menu-link-clrs (link-name link-value main-window line-count) (labels ((add-to-tour-callback () (ev:with-enqueued-process-and-unblock () @@ -393,39 +446,10 @@ link-value) :bold t) (client-bookmark-window:init-window main-window link-value)))) - (inline-image-p (link-value) - (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))) - (inline-possible-p (link-value) - (inline-image-p link-value)) - (inline-type (link-value) - (when (inline-image-p link-value) - :inline-image)) (open-inline-callback () (if (inline-possible-p link-value) - (let ((file-path nil)) - (gui-goodies:with-busy* (main-window) - (setf file-path (slurp-iri main-window link-value))) - (let ((image (gui:make-image file-path)) - (coordinates `(+ (:line ,line-count :char 0) 1 :lines))) - (gui:insert-image (gemtext-widget main-window) image coordinates) - (with-accessors ((ir-lines ir-lines) - (ir-rendered-lines ir-rendered-lines)) main-window - (let* ((parent-line (elt ir-lines (- line-count 1))) - (new-line (copy-list parent-line))) - (setf (getf new-line :type) (inline-type link-value)) - (setf ir-lines - (fresh-vector-insert@ ir-lines - new-line - line-count)) - (setf ir-rendered-lines - (fresh-vector-insert@ ir-lines - "" - line-count)))))) + (gui-goodies:with-busy* (main-window) + (inline-image main-window link-value line-count)) (funcall (link-click-mouse-1-callback-clsr link-value main-window))))) (lambda () (let* ((popup-menu (gui:make-menu nil (_"link menu"))) @@ -864,12 +888,11 @@ (line-index (1+ line-position))) (gui:scroll-until-line-on-top gemtext-widget line-index)))))) - (defun reload-iri-clsr (main-window) (lambda () (with-accessors ((tool-bar tool-bar)) main-window (with-accessors ((iri-entry iri-entry)) tool-bar - (let* ((iri (trim-blanks (gui:text iri-entry)))) + (let ((iri (get-address-bar-text main-window))) (open-iri iri main-window nil)))))) (defun up-iri-clsr (main-window) @@ -964,14 +987,15 @@ (toc-frame toc-frame) (gemtext-widget gemtext-widget) (ir-lines ir-lines)) main-window - (with-accessors ((iri-entry iri-entry) - (back-button back-button) - (reload-button reload-button) - (up-button up-button) - (go-button go-button) - (bookmark-button bookmark-button) - (tour-button tour-button) - (subscribe-button subscribe-button)) tool-bar + (with-accessors ((iri-entry iri-entry) + (back-button back-button) + (reload-button reload-button) + (up-button up-button) + (go-button go-button) + (bookmark-button bookmark-button) + (tour-button tour-button) + (subscribe-button subscribe-button) + (inline-images-button inline-images-button)) tool-bar (let ((entry-autocomplete (gui-mw:autocomplete-entry-widget iri-entry)) (toc-listbox (gui:listbox (toc-listbox toc-frame)))) (gui:bind entry-autocomplete @@ -983,23 +1007,25 @@ (gui:bind toc-listbox #$<>$ (toc-callback-clsr main-window)) - (setf (gui:command go-button) (open-iri-clsr main-window t)) - (setf (gui:command reload-button) (reload-iri-clsr main-window)) - (setf (gui:command back-button) (back-iri-clsr main-window)) - (setf (gui:command up-button) (up-iri-clsr main-window)) - (setf (gui:command bookmark-button) (toggle-bookmark-iri-clsr main-window)) - (setf (gui:command tour-button) (tour-visit-next-iri-clsr main-window)) - (setf (gui:command subscribe-button) (toggle-subscribtion-iri-clsr main-window)))))) + (setf (gui:command go-button) (open-iri-clsr main-window t)) + (setf (gui:command reload-button) (reload-iri-clsr main-window)) + (setf (gui:command back-button) (back-iri-clsr main-window)) + (setf (gui:command up-button) (up-iri-clsr main-window)) + (setf (gui:command bookmark-button) (toggle-bookmark-iri-clsr main-window)) + (setf (gui:command tour-button) (tour-visit-next-iri-clsr main-window)) + (setf (gui:command subscribe-button) (toggle-subscribtion-iri-clsr main-window)) + (setf (gui:command inline-images-button) (inline-all-images-clsr main-window)))))) (defmethod initialize-instance :after ((object tool-bar) &key &allow-other-keys) - (with-accessors ((iri-entry iri-entry) - (back-button back-button) - (reload-button reload-button) - (up-button up-button) - (go-button go-button) - (bookmark-button bookmark-button) - (tour-button tour-button) - (subscribe-button subscribe-button)) object + (with-accessors ((iri-entry iri-entry) + (back-button back-button) + (reload-button reload-button) + (up-button up-button) + (go-button go-button) + (bookmark-button bookmark-button) + (tour-button tour-button) + (subscribe-button subscribe-button) + (inline-images-button inline-images-button)) object (gui:configure object :relief :raised) (setf iri-entry (make-instance 'gui-mw:autocomplete-entry :master object @@ -1013,21 +1039,26 @@ (setf subscribe-button (make-instance 'gui:button :master object :image icons:*gemlog-subscribe*)) - (gui-goodies:attach-tooltips (back-button (_ "go back")) - (reload-button (_ "reload address")) - (go-button (_ "go to address")) - (up-button (_ "one level up")) - (bookmark-button (_ "add or remove bookmark")) - (tour-button (_ "go to the next link in tour")) - (subscribe-button (_ "subscribe/unsubscribe to this gemlog"))) - (gui:grid back-button 0 0 :sticky :nsw) - (gui:grid reload-button 0 1 :sticky :nsw) - (gui:grid up-button 0 2 :sticky :nsw) - (gui:grid iri-entry 0 3 :sticky :nswe :padx +minimum-padding+) - (gui:grid go-button 0 4 :sticky :nsw) - (gui:grid bookmark-button 0 5 :sticky :nsw) - (gui:grid subscribe-button 0 6 :sticky :nsw) - (gui:grid tour-button 0 7 :sticky :nsw) + (setf inline-images-button (make-instance 'gui:button + :master object + :image icons:*inline-images*)) + (gui-goodies:attach-tooltips (back-button (_ "go back")) + (reload-button (_ "reload address")) + (go-button (_ "go to address")) + (up-button (_ "one level up")) + (bookmark-button (_ "add or remove bookmark")) + (tour-button (_ "go to the next link in tour")) + (subscribe-button (_ "subscribe/unsubscribe to this gemlog")) + (inline-images-button (_ "inline images"))) + (gui:grid back-button 0 0 :sticky :nsw) + (gui:grid reload-button 0 1 :sticky :nsw) + (gui:grid up-button 0 2 :sticky :nsw) + (gui:grid iri-entry 0 3 :sticky :nswe :padx +minimum-padding+) + (gui:grid go-button 0 4 :sticky :nsw) + (gui:grid bookmark-button 0 5 :sticky :nsw) + (gui:grid subscribe-button 0 6 :sticky :nsw) + (gui:grid tour-button 0 7 :sticky :nsw) + (gui:grid inline-images-button 0 8 :sticky :nsw) (gui:grid-columnconfigure object 3 :weight 2) object)) @@ -1182,6 +1213,9 @@ (defun set-address-bar-text (main-window text) (setf (gui:text (iri-entry (tool-bar main-window))) text)) +(defun get-address-bar-text (main-window) + (trim-blanks (gui:text (iri-entry (tool-bar main-window))))) + (defun init-main-window () (let ((gui:*debug-tk* nil)) (gui:with-nodgui (:title +program-name+) diff --git a/src/package.lisp b/src/package.lisp index ae90db0..f149df1 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3348,7 +3348,8 @@ :*bus-go* :*dice* :*gemlog-subscribe* - :*gemlog-unsubscribe*)) + :*gemlog-unsubscribe* + :*inline-images*)) (defpackage :validation (:use