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

- [TUI] allowed upload of strings via titan, not only files.

This commit is contained in:
cage 2023-07-07 15:34:01 +02:00
parent e1f185c439
commit b96acd7c66
4 changed files with 26 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/constants.lisp
View File

@ -120,6 +120,8 @@ General Public License for more details."
(define-constant +mime-type-html+ "text/html" :test #'string=)
(define-constant +mime-type-text+ "text/plain" :test #'string=)
(define-constant +db-file+ "db.sqlite3" :test #'string=
:documentation "the filename of the database")

4
src/gemini/titan.lisp
View File

@ -57,13 +57,13 @@
(defgeneric titan-request (host path mime-type size token data
&key port fragment client-certificate certificate-key))
(defmethod titan-request (host path mime-type (size integer) token (data sequence)
(defmethod titan-request (host path mime-type (size integer) token (data string)
&key
(port +gemini-default-port+)
(fragment nil)
(client-certificate nil)
(certificate-key nil))
(flex:with-input-from-sequence (stream data)
(flex:with-input-from-sequence (stream (text-utils:string->octets data))
(titan-request host
path
mime-type

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

@ -91,30 +91,36 @@
(db:gemlog-mark-as-seen url)
(gemini-viewer:ensure-just-one-stream-rendering)
(if (gemini-client:absolute-titan-url-p url)
(let ((upload-file-path nil))
(let ((upload-file-or-string nil))
(labels ((on-token-input-complete (token)
(when (string-not-empty-p token)
(db-utils:with-ready-database (:connect nil)
(db:save-titan-token url token)
(let ((size (fs:file-size upload-file-path))
(mime (os-utils:file->mime-type upload-file-path)))
(let* ((pathname (fs:namestring->pathname upload-file-or-string))
(file-exists-p (fs:file-exists-p pathname))
(size (if file-exists-p
(fs:file-size pathname)
(length upload-file-or-string)))
(mime (if file-exists-p
(os-utils:file->mime-type pathname)
constants:+mime-type-text+))
(upload-data (if file-exists-p
pathname
upload-file-or-string)))
(gemini-viewer::post-titan-url url
upload-file-path
upload-data
size
mime
token)))))
(on-file-input-complete (file-path)
(on-input-complete (data)
(db-utils:with-ready-database (:connect nil)
(if (fs:file-exists-p file-path)
(let ((path-file (fs:namestring->pathname file-path))
(cached-token (db:saved-titan-token url)))
(setf upload-file-path path-file)
(ui:ask-string-input #'on-token-input-complete
:initial-value cached-token
:prompt
(_ "type access token: ")))
(error (_ "no such file: ~a") file-path)))))
(ui:ask-string-input #'on-file-input-complete
(let ((cached-token (db:saved-titan-token url)))
(setf upload-file-or-string data)
(ui:ask-string-input #'on-token-input-complete
:initial-value cached-token
:prompt
(_ "type access token: "))))))
(ui:ask-string-input #'on-input-complete
:prompt (_ "Upload: ")
:complete-fn #'complete:directory-complete)))
(gemini-viewer:load-gemini-url url

1
src/package.lisp
View File

@ -54,6 +54,7 @@
:+mime-type-jpg+
:+mime-type-png+
:+mime-type-html+
:+mime-type-text+
:+db-file+
:+fps+
:+command-window-height+