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

- [gemini] added feature: loading local gemini files from command line (switch: '-o').

This commit is contained in:
cage 2021-03-27 09:19:13 +01:00
parent 029acbe186
commit db34a2f958
11 changed files with 137 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/gemini-viewer.lisp
View File

@ -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)))

14
src/gemini/client.lisp
View File

@ -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))

37
src/gemini/gemini-parser.lisp
View File

@ -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)

2
src/gemini/package.lisp
View File

@ -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

3
src/html-utils.lisp
View File

@ -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

45
src/iri-parser.lisp
View File

@ -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)))))

7
src/main.lisp
View File

@ -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*))

23
src/open-message-link-window.lisp
View File

@ -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

8
src/package.lisp
View File

@ -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

44
src/program-events.lisp
View File

@ -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)

2
src/uri-parser.lisp
View File

@ -17,6 +17,8 @@
(in-package :uri-parser)
(define-constant +segment-separator+ "/" :test #'string=)
(defrule alpha (character-ranges (#\a #\z) (#\A #\Z))
(:text t))