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

- removed direct call to babel:cotets-to-string, using 'to-s' wrapper, instead. 

- [gemini] prevented crash when no previous link to open is found before the selected line.
This commit is contained in:
cage 2022-07-02 10:55:11 +02:00
parent 07725d85d9
commit b004fd5f93
11 changed files with 39 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
scripts/generate-gemlog.lisp
View File

@ -41,9 +41,9 @@
(a:define-constant +archive-topic-file+ "topics.gmi" :test #'string=)
(defparameter *gemlog-header* (format nil "# Posts~%"))
(defparameter *gemlog-header* (format nil "# Posts~2%## Il gemlog di cage~2%"))
(defparameter *topic-index-header* (format nil "# Topics archive~%"))
(defparameter *topic-index-header* (format nil "# Topics archive~2%"))
(defparameter *uri-prefix-path* "/")
@ -255,7 +255,7 @@
:if-exists :supersede)
(write-sequence *topic-index-header* stream)
(loop for topic in all-topics do
(format stream "~a~%" (geminize-h2 topic))
(format stream "~a~2%" (geminize-h2 topic))
(let ((in-topic-posts (remove-if-not (lambda (post)
(let ((post-topics (post-topics post)))
(find topic

2
src/filesystem-utils.lisp
View File

@ -58,7 +58,7 @@
(let ((seq (make-array (file-length stream) :element-type '(unsigned-byte 8))))
(read-sequence seq stream)
(if convert-to-string
(babel:octets-to-string seq :errorp errorp)
(text-utils:to-s seq :errorp errorp)
seq))))
(defun dump-sequence-to-file (seq file)

4
src/gemini-viewer.lisp
View File

@ -344,7 +344,7 @@
"/favicon.txt"
:port port))
(response-body (gemini-client:slurp-gemini-url favicon-url))
(favicon-list (coerce (babel:octets-to-string response-body :errorp t)
(favicon-list (coerce (text-utils:to-s response-body :errorp t)
'list))
(emoji (starting-emoji favicon-list))
(favicon (if emoji
@ -387,7 +387,7 @@
(maybe-render-line preformat-wrapper-event)
(write-sequence preformat-line file-stream))))
(array->string (array remove-bom)
(let ((res (babel:octets-to-string array :errorp nil)))
(let ((res (text-utils:to-s array :errorp nil)))
(if (and (string-not-empty-p res)
remove-bom
(char= (first-elt res)

2
src/gemini/client.lisp
View File

@ -251,7 +251,7 @@
(defun parse-response (stream)
(let* ((header-raw (read-line-into-array stream :add-newline-stopper nil))
(header (babel:octets-to-string header-raw :errorp nil))
(header (text-utils:to-s header-raw :errorp nil))
(parsed-header (parse-gemini-response-header (format nil "~a~a" header #\Newline))))
(debug-gemini (format nil "response header ~s" header))
(with-accessors ((meta meta)

4
src/gemini/subscription.lisp
View File

@ -51,7 +51,7 @@ This function return the 'post-title' substring."
(return-from subtitle-p nil))))
res))))
(when-let* ((data (slurp-gemini-url url))
(page (babel:octets-to-string data))
(page (text-utils:to-s data))
(parsed (parse-gemini-file page))
(iri (iri:iri-parse url))
(title (gemini-first-h1 parsed)))
@ -68,7 +68,7 @@ This function return the 'post-title' substring."
be subscribed before (see: 'gemini-subscription:subcribe'"
(handler-case
(when-let* ((data (slurp-gemini-url url))
(page (babel:octets-to-string data))
(page (text-utils:to-s data))
(parsed (parse-gemini-file page))
(gemlog-iri (iri:iri-parse url)))
(let ((links (remove-if-not (lambda (a) (link-post-timestamp-p (name a)))

2
src/iri-parser.lisp
View File

@ -347,7 +347,7 @@
(format string-stream "#~a" fragment))))))
(write-string (render) stream)))
(defmethod to-s ((object iri))
(defmethod to-s ((object iri) &key &allow-other-keys)
(with-output-to-string (stream)
(render-iri object stream)))

2
src/misc-utils.lisp
View File

@ -995,7 +995,7 @@ to the array"
system-name))
(when (or (< response-code 400)
(> response-code 499))
(let* ((line (babel:octets-to-string (read-line-into-array stream)))
(let* ((line (text-utils:to-s (read-line-into-array stream)))
(fields (text-utils:split-words line)))
fields))))

14
src/text-utils.lisp
View File

@ -72,12 +72,12 @@
(return-from utf8-encoded-p nil))))
t)))))
(defgeneric to-s (object))
(defgeneric to-s (object &key &allow-other-keys))
(defmethod to-s ((object string))
(defmethod to-s ((object string) &key &allow-other-keys)
object)
(defmethod to-s ((object vector))
(defmethod to-s ((object vector) &key (errorp t) &allow-other-keys)
(handler-case
(let ((byte-vector (make-array (length object)
:element-type '(unsigned-byte 8)
@ -86,14 +86,14 @@
(loop for i from 0 below (length object) do
(setf (aref byte-vector i)
(logand (aref object i) #xff)))
(babel:octets-to-string byte-vector :errorp nil))
(babel:octets-to-string byte-vector :errorp errorp))
(error ()
(coerce object 'string))))
(defmethod to-s ((object character))
(defmethod to-s ((object character) &key &allow-other-keys)
(string object))
(defmethod to-s (object)
(defmethod to-s (object &key &allow-other-keys)
(format nil "~a" object))
(defun clean-unprintable-chars (string)
@ -179,7 +179,7 @@
(flex:with-input-from-sequence (stream (babel:string-to-octets text))
(loop for line-as-array = (misc:read-line-into-array stream)
while line-as-array do
(push (babel:octets-to-string line-as-array) res)))
(push (text-utils:to-s line-as-array) res)))
(let ((*blanks* '(#\Newline)))
(reverse (mapcar #'trim-blanks res)))))

39
src/ui-goodies.lisp
View File

@ -1396,26 +1396,25 @@ Browse and optionally open the links the text of the message window contains."
(reverse-search-rows (when reverse-search
(line-oriented-window:rows-safe-subseq win
0
:end row-end-search)))
(link-line (if reverse-search
(message-window:row-find-original-object reverse-search-rows
'gemini-parser:link-line
:from-end t
:end row-end-search)
(message-window:row-find-original-object visible-rows
'gemini-parser:link-line)))
(link-object (message-window:extract-original-object link-line)))
(when link-object
(let* ((uri (gemini-parser::link-value link-object))
(current-url (ignore-errors (iri:iri-parse (gemini-viewer:current-gemini-url))))
(absolute-uri (if (or (null current-url)
(iri:absolute-url-p uri))
uri
(gemini-parser:absolutize-link uri
(uri:host current-url)
(uri:port current-url)
(uri:path current-url)))))
(open-message-link-window:open-message-link absolute-uri nil)))))
:end row-end-search))))
(when-let* ((link-line (if reverse-search
(message-window:row-find-original-object reverse-search-rows
'gemini-parser:link-line
:from-end t
:end row-end-search)
(message-window:row-find-original-object visible-rows
'gemini-parser:link-line)))
(link-object (message-window:extract-original-object link-line))
(uri (gemini-parser::link-value link-object))
(current-url (ignore-errors (iri:iri-parse (gemini-viewer:current-gemini-url))))
(absolute-uri (if (or (null current-url)
(iri:absolute-url-p uri))
uri
(gemini-parser:absolutize-link uri
(uri:host current-url)
(uri:port current-url)
(uri:path current-url)))))
(open-message-link-window:open-message-link absolute-uri nil))))
(defun open-previous-link ()
"Open the first link above the first visible row."

2
src/uri-parser.lisp
View File

@ -325,6 +325,6 @@
(setf (uri:path copy) clean-path))
copy))
(defmethod to-s ((object uri:uri))
(defmethod to-s ((object uri:uri) &key &allow-other-keys)
(with-output-to-string (stream)
(uri:render-uri object stream)))

2
src/zip-info.lisp
View File

@ -209,7 +209,7 @@
(file-position stream (+ +cd-fixed-size+ start-of-central-directory))
(let ((res (make-array file-name-length :element-type +byte-type+)))
(read-sequence res stream)
(babel:octets-to-string res))))
(text-utils:to-s res))))
(defun list-entries (path)
(let ((start-of-central-directory (start-of-central-directory path))