cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [GUI] added commands to show page's source.

This commit is contained in:
cage 2024-04-19 19:57:53 +02:00
parent 342f34874d
commit 46ba8f2d07
13 changed files with 1911 additions and 1795 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/shared-gui.conf
View File

@ -223,6 +223,8 @@ keybinding.about = "Alt-a"
keybinding.type-address = "Alt-d"
keybinding.view-source = "Alt-u"
keybinding.back = "Control-BackSpace"
keybinding.up = "U"

594
po/de.po
View File

File diff suppressed because it is too large Load Diff

594
po/es.po
View File

File diff suppressed because it is too large Load Diff

595
po/fr.po
View File

File diff suppressed because it is too large Load Diff

582
po/it.po
View File

File diff suppressed because it is too large Load Diff

594
po/pl.po
View File

File diff suppressed because it is too large Load Diff

596
po/tinmop.pot
View File

File diff suppressed because it is too large Load Diff

12
src/constants.lisp
View File

@ -169,15 +169,17 @@ General Public License for more details."
(define-constant +octect-type+ '(unsigned-byte 8) :test #'equalp)
(define-constant +gemini-file-extension+ "gmi" :test #'string=)
(define-constant +gemini-file-extension+ "gmi" :test #'string=)
(define-constant +file-scheme+ "file" :test #'string=)
(define-constant +file-scheme+ "file" :test #'string=)
(define-constant +internal-scheme+ "about" :test #'string=)
(define-constant +internal-scheme+ "about" :test #'string=)
(define-constant +internal-path-bookmark+ "bookmark" :test #'string=)
(define-constant +internal-path-bookmark+ "bookmark" :test #'string=)
(define-constant +internal-path-gemlogs+ "gemlog" :test #'string=)
(define-constant +internal-path-gemlogs+ "gemlog" :test #'string=)
(define-constant +internal-scheme-view-source+ "view-source" :test #'string=)
(define-constant +fediverse-account-name-server-separator+ "@" :test #'string=)

3
src/gui/client/internal-paths.lisp
View File

@ -9,6 +9,9 @@
(defun internal-iri-gemlogs ()
(make-internal-iri +internal-path-gemlogs+))
(defun internal-iri-view-source (path &optional (query nil) (fragment nil))
(iri:make-iri +internal-scheme-view-source+ nil nil nil path query fragment))
(defun show-bookmarks-page (main-window)
(ev:with-enqueued-process-and-unblock ()
(let ((parsed-page (comm:make-request :gemini-generate-bookmark-page 1))

119
src/gui/client/main-window.lisp
View File

@ -213,14 +213,14 @@
(eq (status stream-wrapper) +stream-status-canceled+)))
(print-info-message (_ "Stream started"))
(let ((stream-thread (make-thread (lambda ()
(slurp-gemini-stream main-window
iri
stream-wrapper
:use-cache use-cache
:process-function
process-function
:aborting-function
#'aborting-function)))))
(slurp-gemini-stream main-window
iri
stream-wrapper
:use-cache use-cache
:process-function
process-function
:aborting-function
#'aborting-function)))))
(setf (fetching-thread stream-wrapper) stream-thread)
stream-wrapper)))))
@ -244,6 +244,10 @@
(_ "Streams")
#'menu:show-streams
:accelerator (client-configuration:get-keybinding :stream))
(gui:make-menubutton tools
(_ "View source")
(menu:show-page-source-clsr main-window)
:accelerator (client-configuration:get-keybinding :view-source))
(gui:make-menubutton file
(_ "Quit")
#'menu:quit
@ -357,7 +361,8 @@
(gui:focus (toc-frame main-window))
(open-iri link-value
main-window
use-cache :status status)))))
use-cache
:status status)))))
(defun remove-standard-port (iri)
(let ((copy (iri:copy-iri (iri:iri-parse iri))))
@ -963,11 +968,67 @@ local file paths."
(strcat iri "/")
iri)))
(defun collect-source-lines-clsr (main-window)
(lambda (stream-wrapper lines)
;; this test ensures that the
;; collecting events left on
;; the queue won't be actually
;; processed, just discarded
(when (eq (status stream-wrapper)
+stream-status-streaming+)
(with-accessors ((ir-lines ir-lines)
(ir-rendered-lines ir-rendered-lines)
(gemtext-font-scaling gemtext-font-scaling)
(gemtext-widget gemtext-widget)) main-window
(let ((starting-index (if (vector-empty-p ir-lines)
0
(length ir-lines)))
(font (gui-conf:gemini-preformatted-text-font-configuration)))
(multiple-value-bind (background foreground)
(gui-conf:gemini-preformatted-text-colors)
(loop for line in lines do
(vector-push-extend line ir-lines)
(let* ((type (ir-type line))
(type-as-keyword (format-keyword type)))
(case type-as-keyword
(:vertical-space
(vector-push-extend (format nil "")
ir-rendered-lines))
(otherwise
(vector-push-extend (ir-source-line line)
ir-rendered-lines)))))
(gui:configure gemtext-widget
:wrap :none
:font font
:foreground foreground
:background background)
(flet ((render-line (text)
(gui:append-text gemtext-widget text)))
(loop with render-line-count = starting-index
for rendered-line across (subseq ir-rendered-lines starting-index)
for ir-line across (subseq ir-lines starting-index)
until (interrupt-rendering-p main-window)
do
(incf render-line-count)
(let ((type (ir-type ir-line)))
(case (format-keyword type)
(:vertical-space
(gui:append-line gemtext-widget ""))
(otherwise
(render-line rendered-line))))))))))))
(defun open-iri (iri main-window use-cache &key (status +stream-status-streaming+))
(let ((actual-iri (remove-standard-port iri)))
(handler-case
(let ((parsed-iri (iri:iri-parse actual-iri)))
(cond
((string= (uri:scheme parsed-iri) +internal-scheme-view-source+)
(setf (uri:scheme parsed-iri) gemini-constants:+gemini-scheme+)
(start-stream-iri (iri-ensure-path (to-s parsed-iri))
main-window
use-cache
:status status
:process-iri-lines-function (collect-source-lines-clsr main-window)))
((iri:iri= actual-iri (internal-iri-bookmark))
(initialize-ir-lines main-window)
(funcall (menu:show-bookmarks-clsr main-window)))
@ -980,7 +1041,7 @@ local file paths."
(start-stream-iri (iri-ensure-path actual-iri)
main-window
use-cache
status)
:status status)
(client-stream-frame::refresh-all-streams
(client-stream-frame::table stream-frame))))
((or (null (uri:scheme parsed-iri))
@ -1071,7 +1132,21 @@ local file paths."
(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+))
(defun collect-iri-lines-clsr (main-window iri)
(lambda (stream-wrapper lines)
;; this test ensures that the
;; collecting events left on
;; the queue won't be actually
;; processed, just discarded
(when (eq (status stream-wrapper)
+stream-status-streaming+)
(collect-ir-lines iri main-window lines))))
(defun start-stream-iri (iri main-window use-cache
&key
(status +stream-status-streaming+)
(process-iri-lines-function (collect-iri-lines-clsr main-window
iri)))
(let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request
1
ev:+maximum-event-priority+
@ -1100,7 +1175,7 @@ local file paths."
1
ev:+maximum-event-priority+
iri)
(start-stream-iri iri main-window use-cache status)))
(start-stream-iri iri main-window use-cache :status status)))
((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))
@ -1131,7 +1206,7 @@ local file paths."
ev:+maximum-event-priority+
certificate-path
actual-password)
(start-stream-iri iri main-window use-cache status)))
(start-stream-iri iri main-window use-cache :status status)))
((gemini-client:header-redirect-p status-code)
(when (gui:ask-yesno (format nil (_ "Follow redirection to ~a?") meta)
:title (_ "Redirection")
@ -1139,7 +1214,7 @@ local file paths."
(let ((redirect-iri (if (iri:absolute-url-p meta)
meta
(absolutize-link iri meta))))
(start-stream-iri redirect-iri main-window use-cache status))))
(start-stream-iri redirect-iri main-window use-cache :status status))))
((gemini-client:header-success-p status-code)
(cond
((eq status +stream-status-streaming+)
@ -1154,15 +1229,7 @@ local file paths."
iri
:use-cache t
:status status
:process-function
(lambda (stream-wrapper lines)
;; this test ensures that the
;; collecting events left on
;; the queue won't be actually
;; processed, just discarded
(when (eq (status stream-wrapper)
+stream-status-streaming+)
(collect-ir-lines iri main-window lines)))))
:process-function process-iri-lines-function))
((gemini-client:text-file-stream-p meta)
(slurp-text-data main-window iri))
(t
@ -1705,6 +1772,12 @@ local file paths."
(render-ir-lines (get-address-bar-text main-window) main-window))))
(defun initialize-keybindings (main-window target)
(gui:bind target
(client-configuration:get-keybinding :view-source)
(lambda (e)
(declare (ignore e))
(funcall (menu:show-page-source-clsr main-window)))
:exclusive t)
(gui:bind target
(client-configuration:get-keybinding :quit)
(lambda (e)

8
src/gui/client/menu-command.lisp
View File

@ -82,3 +82,11 @@
(let ((master gui-goodies:*toplevel*)
(main-window gui-goodies:*main-frame*))
(client-gemlog-window:init-window master main-window)))
(defun show-page-source-clsr (main-window)
(lambda ()
(a:when-let ((iri (iri:iri-parse (client-main-window::get-address-bar-text main-window)
:null-on-error t)))
(setf (uri:scheme iri) +internal-scheme-view-source+)
(client-main-window::set-address-bar-text main-window (to-s iri))
(client-main-window::open-iri (to-s iri) main-window nil))))

3
src/json-rpc2.lisp
View File

@ -437,7 +437,8 @@
(make-response nil
id
:error-object (make-failed-function-call-error-message (format nil
"~a"
"[~a] ~a"
request
e)
data))))
(handler-case

4
src/package.lisp
View File

@ -77,6 +77,7 @@
:+internal-scheme+
:+internal-path-bookmark+
:+internal-path-gemlogs+
:+internal-scheme-view-source+
:+fediverse-account-name-server-separator+
:+language-codes+
;; GUI
@ -3532,7 +3533,8 @@
:manage-bookmarks-clsr
:show-search-frame-clsr
:show-tour
:manage-gemlogs))
:manage-gemlogs
:show-page-source-clsr))
(defpackage :client-certificates-window
(:use