diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp index ea3ce9e..14f440c 100644 --- a/src/gemini-viewer.lisp +++ b/src/gemini-viewer.lisp @@ -730,3 +730,12 @@ (select-row *gemini-streams-window* 0)) (draw *gemini-streams-window*) *gemini-streams-window*)) + +(defun load-gemini-url (url) + "Load `url', that is a web resource or a local file. This function +can be used only when the event polling is enabled (e.g. from user +command) otherwise te actual code to get the resource will never be +executed." + (let* ((event (make-instance 'program-events:gemini-request-event + :url url))) + (program-events:push-event event))) diff --git a/src/gemini/client.lisp b/src/gemini/client.lisp index 93631f4..7ca3eab 100644 --- a/src/gemini/client.lisp +++ b/src/gemini/client.lisp @@ -274,8 +274,9 @@ (t parsed-header)))))) -(defun absolute-url-p (url) - (text-utils:string-starts-with-p +gemini-scheme+ url)) +(defun absolute-gemini-url-p (url) + (when-let ((iri (iri:iri-parse url :null-on-error t))) + (string= (uri:scheme iri) +gemini-scheme+))) (defun close-ssl-socket (socket) (usocket:socket-close socket)) @@ -306,19 +307,22 @@ (path (uri:path iri)) (query (uri:query iri)) (fragment (uri:fragment iri)) - (port (or (uri:port iri) + (port (or (uri:port iri) +gemini-default-port+)) + (scheme (uri:scheme iri)) (actual-iri (gemini-parser:make-gemini-iri host path :query query :port port - :fragment fragment))) + :fragment fragment + :scheme scheme))) (values actual-iri host path query port - fragment))) + fragment + scheme))) (defun debug-gemini (&rest data) (declare (ignorable data)) diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index 4c40139..98b3a6d 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -228,14 +228,15 @@ (defun make-gemini-iri (host path &key (query nil) (port +gemini-default-port+) - (fragment nil)) + (fragment nil) + (scheme +gemini-scheme+)) (let* ((actual-path (if (string-starts-with-p "/" path) (subseq path 1) path)) (actual-port (if port (to-s port) (to-s +gemini-default-port+))) - (iri (strcat +gemini-scheme+ "://" + (iri (strcat scheme "://" host ":" actual-port "/" actual-path))) @@ -245,15 +246,29 @@ (setf iri (strcat iri "#" fragment))) iri)) -(defun sexp->links (parsed-gemini original-host original-port original-path) - (loop for node in parsed-gemini when (html-utils:tag= :a node) collect - (let ((link-value (html-utils:attribute-value (html-utils:find-attribute :href node)))) - (make-instance 'gemini-link - :target (absolutize-link link-value - original-host - original-port - original-path) - :name (tag-value node))))) +(defun sexp->links (parsed-gemini original-host original-port original-path + &key (comes-from-local-file nil)) + (loop + for node in parsed-gemini + when (html-utils:tag= :a node) + collect + (let* ((link-value (html-utils:node->link node)) + (absolute-p (iri:absolute-url-p link-value)) + (rendered-link (cond + (absolute-p + link-value) + (comes-from-local-file + (strcat original-path + iri:+segment-separator+ + link-value)) + (t + (absolutize-link link-value + original-host + original-port + original-path))))) + (make-instance 'gemini-link + :target rendered-link + :name (tag-value node))))) (defun gemini-link-iri-p (iri) (conditions:with-default-on-error (nil) diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp index 352ad13..4b418c4 100644 --- a/src/gemini/package.lisp +++ b/src/gemini/package.lisp @@ -100,7 +100,7 @@ :response-sensitive-input-p :response-redirect-p :response-success-p - :absolute-url-p + :absolute-gemini-url-p :init-default-gemini-theme :gemini-file-response :status-code diff --git a/src/html-utils.lisp b/src/html-utils.lisp index 27982f2..89241b3 100644 --- a/src/html-utils.lisp +++ b/src/html-utils.lisp @@ -75,6 +75,9 @@ (position-if (lambda (a) (tag= tag a)) node)) +(defun node->link (node) + (html-utils:attribute-value (html-utils:find-attribute :href node))) + (defun html->text (html &key (add-link-footnotes t)) "Transform html to text, note that if `add-link-footnotes` is non nil footnotes that marks html link in the text are added aftere the body of the message diff --git a/src/iri-parser.lisp b/src/iri-parser.lisp index 7043ca7..071e15f 100644 --- a/src/iri-parser.lisp +++ b/src/iri-parser.lisp @@ -17,6 +17,8 @@ (in-package :iri-parser) +(define-constant +segment-separator+ "/" :test #'string=) + (defrule alpha (character-ranges (#\a #\z) (#\A #\Z)) (:text t)) @@ -244,23 +246,28 @@ :query query :fragment fragment)) -(defun iri-parse (iri) - (let* ((parsed (parse 'iri-reference iri :junk-allowed nil)) - (res (mapcar (lambda (a) (cond - ((typep a 'string) - (if (text-utils:string-empty-p a) - nil - a)) - (t a))) - (list (first parsed) ; scheme - (second parsed) ; user-credentials - (third parsed) ; host - (fourth parsed) ; port - (fifth parsed) ; path - (sixth parsed) ; query - (seventh parsed))))) ; fragment - (values (apply #'make-iri res) - res))) +(defun iri-parse (iri &key (null-on-error nil)) + (handler-case + (let* ((parsed (parse 'iri-reference iri :junk-allowed nil)) + (res (mapcar (lambda (a) (cond + ((typep a 'string) + (if (text-utils:string-empty-p a) + nil + a)) + (t a))) + (list (first parsed) ; scheme + (second parsed) ; user-credentials + (third parsed) ; host + (fourth parsed) ; port + (fifth parsed) ; path + (sixth parsed) ; query + (seventh parsed))))) ; fragment + (values (apply #'make-iri res) + res)) + (esrap:esrap-parse-error (e) + (if null-on-error + nil + (error e))))) (defun copy-iri (from) (let ((scheme (uri:scheme from)) @@ -315,3 +322,7 @@ (defmethod to-s ((object iri)) (with-output-to-string (stream) (render-iri object stream))) + +(defun absolute-url-p (url) + (when-let ((iri (iri:iri-parse url :null-on-error t))) + (not (null (uri:scheme iri))))) diff --git a/src/main.lisp b/src/main.lisp index f9b532a..0036c07 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -95,11 +95,6 @@ etc.) happened" (defun reset-timeline-pagination () (ui:reset-timeline-pagination)) -(defun load-gemini-url (url) - (let* ((event (make-instance 'program-events:gemini-request-event - :url url))) - (program-events:push-event event))) - (defun load-configuration-files () (format t (_ "Loading configuration file ~a~%") swconf:+shared-conf-filename+) (handler-case @@ -147,7 +142,7 @@ etc.) happened" (client:init) (client:authorize) (if command-line:*gemini-url* - (load-gemini-url command-line:*gemini-url*) + (gemini-viewer:load-gemini-url command-line:*gemini-url*) (progn (when command-line:*module-file* (modules:load-module command-line:*module-file*)) diff --git a/src/open-message-link-window.lisp b/src/open-message-link-window.lisp index b404da3..8fb5e9c 100644 --- a/src/open-message-link-window.lisp +++ b/src/open-message-link-window.lisp @@ -71,9 +71,11 @@ *open-message-link-window*)) (defun open-message-link (url enqueue) - (if (string-starts-with-p gemini-constants:+gemini-scheme+ url) - (progn - (let ((program-events:*process-events-immediately* t) + (let* ((parsed (iri:iri-parse url)) + (scheme (uri:scheme parsed))) + (cond + ((string= gemini-constants:+gemini-scheme+ scheme) + (let ((program-events:*process-events-immediately* t) (event (make-instance 'program-events:gemini-push-behind-downloading-event :priority program-events:+maximum-event-priority+))) (db:insert-in-history (ui:gemini-open-url-prompt) url) @@ -82,10 +84,17 @@ (program-events:push-event event)) (gemini-viewer:request url :enqueue enqueue :use-cached-file-if-exists t)) - (let ((program (swconf:link-regex->program-to-use url))) - (if program - (os-utils:open-link-with-program program url) - (os-utils:xdg-open url))))) + ((null scheme) + (let* ((event (make-instance 'program-events:gemini-request-event + :url url + :give-focus-to-message-window nil))) + (program-events:push-event event))) + (t + (let ((program (swconf:link-regex->program-to-use url))) + (if program + (os-utils:open-link-with-program program url) + (os-utils:xdg-open url))))))) + (defclass open-links-window () ((links diff --git a/src/package.lisp b/src/package.lisp index d04749d..dda701f 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -399,6 +399,7 @@ :find-attribute :find-tag :position-tag + :node->link :html->text)) (defpackage :resources-utils @@ -660,11 +661,13 @@ :text-utils) (:nicknames :iri) (:export + :+segment-separator+ :iri :copy-iri :render-iri :make-iri - :iri-parse)) + :iri-parse + :absolute-url-p)) (defpackage :x509 (:use @@ -2215,7 +2218,8 @@ :abort-downloading :downloading-allowed-p :request - :open-gemini-stream-window)) + :open-gemini-stream-window + :load-gemini-url)) (defpackage :main-window (:use diff --git a/src/program-events.lisp b/src/program-events.lisp index bcd898d..bf0e7c9 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -996,13 +996,38 @@ (use-cached-file-if-exists :initform nil :initarg :use-cached-file-if-exists - :accessor use-cached-file-if-exists))) + :accessor use-cached-file-if-exists) + (give-focus-to-message-window + :initform t + :initarg :give-focus-to-message-window + :reader give-focus-to-message-window-p + :writer (setf give-focus-to-message-window)))) (defmethod process-event ((object gemini-request-event)) - (with-accessors ((url url) - (use-cached-file-if-exists use-cached-file-if-exists)) object - (ui:focus-to-message-window) - (gemini-viewer:request url :use-cached-file-if-exists use-cached-file-if-exists))) + (tui:with-notify-errors + (with-accessors ((url url) + (give-focus-to-message-window-p give-focus-to-message-window-p) + (use-cached-file-if-exists use-cached-file-if-exists)) object + (let ((window specials:*message-window*)) + (setf (windows:keybindings window) + keybindings:*gemini-message-keymap*) + (when give-focus-to-message-window-p + (ui:focus-to-message-window)) + (if (gemini-client:absolute-gemini-url-p url) + (gemini-viewer:request url :use-cached-file-if-exists use-cached-file-if-exists) + (let* ((file-string (fs:slurp-file url)) + (parent-dir (fs:parent-dir-path url)) + (parsed (gemini-parser:parse-gemini-file file-string)) + (links (gemini-parser:sexp->links parsed + nil + nil + parent-dir + :comes-from-local-file t)) + (text (gemini-parser:sexp->text parsed + gemini-client:*gemini-page-theme*))) + (gemini-viewer:maybe-initialize-metadata window) + (refresh-gemini-message-window links file-string text nil) + (windows:draw window))))))) (defclass gemini-back-event (program-event) ()) @@ -1040,9 +1065,12 @@ (push new-row reversed-rows)) (setf rows (reverse reversed-rows)))) (progn - (setf (message-window:source-text win) rendered-text) - (setf (gemini-viewer:gemini-metadata-source-file window-metadata) source) - (setf (gemini-viewer:gemini-metadata-links window-metadata) links))))) + (when rendered-text + (setf (message-window:source-text win) rendered-text)) + (when source + (setf (gemini-viewer:gemini-metadata-source-file window-metadata) source)) + (when links + (setf (gemini-viewer:gemini-metadata-links window-metadata) links)))))) (defmethod process-event ((object gemini-got-line-event)) (with-accessors ((response payload) diff --git a/src/uri-parser.lisp b/src/uri-parser.lisp index 93054dc..4d32539 100644 --- a/src/uri-parser.lisp +++ b/src/uri-parser.lisp @@ -17,6 +17,8 @@ (in-package :uri-parser) +(define-constant +segment-separator+ "/" :test #'string=) + (defrule alpha (character-ranges (#\a #\z) (#\A #\Z)) (:text t))