mirror of https://codeberg.org/cage/tinmop/
- [GUI] added commands to show page's source.
This commit is contained in:
parent
342f34874d
commit
46ba8f2d07
|
@ -223,6 +223,8 @@ keybinding.about = "Alt-a"
|
||||||
|
|
||||||
keybinding.type-address = "Alt-d"
|
keybinding.type-address = "Alt-d"
|
||||||
|
|
||||||
|
keybinding.view-source = "Alt-u"
|
||||||
|
|
||||||
keybinding.back = "Control-BackSpace"
|
keybinding.back = "Control-BackSpace"
|
||||||
|
|
||||||
keybinding.up = "U"
|
keybinding.up = "U"
|
||||||
|
|
596
po/tinmop.pot
596
po/tinmop.pot
File diff suppressed because it is too large
Load Diff
|
@ -169,15 +169,17 @@ General Public License for more details."
|
||||||
|
|
||||||
(define-constant +octect-type+ '(unsigned-byte 8) :test #'equalp)
|
(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=)
|
(define-constant +fediverse-account-name-server-separator+ "@" :test #'string=)
|
||||||
|
|
||||||
|
|
|
@ -9,6 +9,9 @@
|
||||||
(defun internal-iri-gemlogs ()
|
(defun internal-iri-gemlogs ()
|
||||||
(make-internal-iri +internal-path-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)
|
(defun show-bookmarks-page (main-window)
|
||||||
(ev:with-enqueued-process-and-unblock ()
|
(ev:with-enqueued-process-and-unblock ()
|
||||||
(let ((parsed-page (comm:make-request :gemini-generate-bookmark-page 1))
|
(let ((parsed-page (comm:make-request :gemini-generate-bookmark-page 1))
|
||||||
|
|
|
@ -213,14 +213,14 @@
|
||||||
(eq (status stream-wrapper) +stream-status-canceled+)))
|
(eq (status stream-wrapper) +stream-status-canceled+)))
|
||||||
(print-info-message (_ "Stream started"))
|
(print-info-message (_ "Stream started"))
|
||||||
(let ((stream-thread (make-thread (lambda ()
|
(let ((stream-thread (make-thread (lambda ()
|
||||||
(slurp-gemini-stream main-window
|
(slurp-gemini-stream main-window
|
||||||
iri
|
iri
|
||||||
stream-wrapper
|
stream-wrapper
|
||||||
:use-cache use-cache
|
:use-cache use-cache
|
||||||
:process-function
|
:process-function
|
||||||
process-function
|
process-function
|
||||||
:aborting-function
|
:aborting-function
|
||||||
#'aborting-function)))))
|
#'aborting-function)))))
|
||||||
(setf (fetching-thread stream-wrapper) stream-thread)
|
(setf (fetching-thread stream-wrapper) stream-thread)
|
||||||
stream-wrapper)))))
|
stream-wrapper)))))
|
||||||
|
|
||||||
|
@ -244,6 +244,10 @@
|
||||||
(_ "Streams")
|
(_ "Streams")
|
||||||
#'menu:show-streams
|
#'menu:show-streams
|
||||||
:accelerator (client-configuration:get-keybinding :stream))
|
: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
|
(gui:make-menubutton file
|
||||||
(_ "Quit")
|
(_ "Quit")
|
||||||
#'menu:quit
|
#'menu:quit
|
||||||
|
@ -357,7 +361,8 @@
|
||||||
(gui:focus (toc-frame main-window))
|
(gui:focus (toc-frame main-window))
|
||||||
(open-iri link-value
|
(open-iri link-value
|
||||||
main-window
|
main-window
|
||||||
use-cache :status status)))))
|
use-cache
|
||||||
|
:status status)))))
|
||||||
|
|
||||||
(defun remove-standard-port (iri)
|
(defun remove-standard-port (iri)
|
||||||
(let ((copy (iri:copy-iri (iri:iri-parse iri))))
|
(let ((copy (iri:copy-iri (iri:iri-parse iri))))
|
||||||
|
@ -963,11 +968,67 @@ local file paths."
|
||||||
(strcat iri "/")
|
(strcat iri "/")
|
||||||
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+))
|
(defun open-iri (iri main-window use-cache &key (status +stream-status-streaming+))
|
||||||
(let ((actual-iri (remove-standard-port iri)))
|
(let ((actual-iri (remove-standard-port iri)))
|
||||||
(handler-case
|
(handler-case
|
||||||
(let ((parsed-iri (iri:iri-parse actual-iri)))
|
(let ((parsed-iri (iri:iri-parse actual-iri)))
|
||||||
(cond
|
(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))
|
((iri:iri= actual-iri (internal-iri-bookmark))
|
||||||
(initialize-ir-lines main-window)
|
(initialize-ir-lines main-window)
|
||||||
(funcall (menu:show-bookmarks-clsr main-window)))
|
(funcall (menu:show-bookmarks-clsr main-window)))
|
||||||
|
@ -980,7 +1041,7 @@ local file paths."
|
||||||
(start-stream-iri (iri-ensure-path actual-iri)
|
(start-stream-iri (iri-ensure-path actual-iri)
|
||||||
main-window
|
main-window
|
||||||
use-cache
|
use-cache
|
||||||
status)
|
:status status)
|
||||||
(client-stream-frame::refresh-all-streams
|
(client-stream-frame::refresh-all-streams
|
||||||
(client-stream-frame::table stream-frame))))
|
(client-stream-frame::table stream-frame))))
|
||||||
((or (null (uri:scheme parsed-iri))
|
((or (null (uri:scheme parsed-iri))
|
||||||
|
@ -1071,7 +1132,21 @@ local file paths."
|
||||||
(wait-until-download-complete stream-info support-file))))))
|
(wait-until-download-complete stream-info support-file))))))
|
||||||
(wait-enough-data)))
|
(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
|
(let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request
|
||||||
1
|
1
|
||||||
ev:+maximum-event-priority+
|
ev:+maximum-event-priority+
|
||||||
|
@ -1100,7 +1175,7 @@ local file paths."
|
||||||
1
|
1
|
||||||
ev:+maximum-event-priority+
|
ev:+maximum-event-priority+
|
||||||
iri)
|
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)
|
((or (gemini-client:header-temporary-failure-p status-code)
|
||||||
(gemini-client:header-permanent-failure-p status-code)
|
(gemini-client:header-permanent-failure-p status-code)
|
||||||
(gemini-client:header-certificate-failure-p status-code))
|
(gemini-client:header-certificate-failure-p status-code))
|
||||||
|
@ -1131,7 +1206,7 @@ local file paths."
|
||||||
ev:+maximum-event-priority+
|
ev:+maximum-event-priority+
|
||||||
certificate-path
|
certificate-path
|
||||||
actual-password)
|
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)
|
((gemini-client:header-redirect-p status-code)
|
||||||
(when (gui:ask-yesno (format nil (_ "Follow redirection to ~a?") meta)
|
(when (gui:ask-yesno (format nil (_ "Follow redirection to ~a?") meta)
|
||||||
:title (_ "Redirection")
|
:title (_ "Redirection")
|
||||||
|
@ -1139,7 +1214,7 @@ local file paths."
|
||||||
(let ((redirect-iri (if (iri:absolute-url-p meta)
|
(let ((redirect-iri (if (iri:absolute-url-p meta)
|
||||||
meta
|
meta
|
||||||
(absolutize-link iri 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)
|
((gemini-client:header-success-p status-code)
|
||||||
(cond
|
(cond
|
||||||
((eq status +stream-status-streaming+)
|
((eq status +stream-status-streaming+)
|
||||||
|
@ -1154,15 +1229,7 @@ local file paths."
|
||||||
iri
|
iri
|
||||||
:use-cache t
|
:use-cache t
|
||||||
:status status
|
:status status
|
||||||
:process-function
|
:process-function process-iri-lines-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)))))
|
|
||||||
((gemini-client:text-file-stream-p meta)
|
((gemini-client:text-file-stream-p meta)
|
||||||
(slurp-text-data main-window iri))
|
(slurp-text-data main-window iri))
|
||||||
(t
|
(t
|
||||||
|
@ -1705,6 +1772,12 @@ local file paths."
|
||||||
(render-ir-lines (get-address-bar-text main-window) main-window))))
|
(render-ir-lines (get-address-bar-text main-window) main-window))))
|
||||||
|
|
||||||
(defun initialize-keybindings (main-window target)
|
(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
|
(gui:bind target
|
||||||
(client-configuration:get-keybinding :quit)
|
(client-configuration:get-keybinding :quit)
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
|
|
|
@ -82,3 +82,11 @@
|
||||||
(let ((master gui-goodies:*toplevel*)
|
(let ((master gui-goodies:*toplevel*)
|
||||||
(main-window gui-goodies:*main-frame*))
|
(main-window gui-goodies:*main-frame*))
|
||||||
(client-gemlog-window:init-window master main-window)))
|
(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))))
|
||||||
|
|
|
@ -437,7 +437,8 @@
|
||||||
(make-response nil
|
(make-response nil
|
||||||
id
|
id
|
||||||
:error-object (make-failed-function-call-error-message (format nil
|
:error-object (make-failed-function-call-error-message (format nil
|
||||||
"~a"
|
"[~a] ~a"
|
||||||
|
request
|
||||||
e)
|
e)
|
||||||
data))))
|
data))))
|
||||||
(handler-case
|
(handler-case
|
||||||
|
|
|
@ -77,6 +77,7 @@
|
||||||
:+internal-scheme+
|
:+internal-scheme+
|
||||||
:+internal-path-bookmark+
|
:+internal-path-bookmark+
|
||||||
:+internal-path-gemlogs+
|
:+internal-path-gemlogs+
|
||||||
|
:+internal-scheme-view-source+
|
||||||
:+fediverse-account-name-server-separator+
|
:+fediverse-account-name-server-separator+
|
||||||
:+language-codes+
|
:+language-codes+
|
||||||
;; GUI
|
;; GUI
|
||||||
|
@ -3532,7 +3533,8 @@
|
||||||
:manage-bookmarks-clsr
|
:manage-bookmarks-clsr
|
||||||
:show-search-frame-clsr
|
:show-search-frame-clsr
|
||||||
:show-tour
|
:show-tour
|
||||||
:manage-gemlogs))
|
:manage-gemlogs
|
||||||
|
:show-page-source-clsr))
|
||||||
|
|
||||||
(defpackage :client-certificates-window
|
(defpackage :client-certificates-window
|
||||||
(:use
|
(:use
|
||||||
|
|
Loading…
Reference in New Issue