diff --git a/etc/shared.conf b/etc/shared.conf index 6f0088f..4444297 100644 --- a/etc/shared.conf +++ b/etc/shared.conf @@ -225,7 +225,7 @@ gemini.exclusive.mode.links.height = 1/4 # following: valid values are "tinmop" "me" "internal" # ▼▼▼▼▼▼▼▼ open "^((gemini://)|(\\.)|(/)).+gmi$" with "tinmop" -open "^((gemini://)|(\\.)|(/)).+txt$" with "tinmop" +#open "^((gemini://)|(\\.)|(/)).+txt$" with "tinmop" open "^((gemini://)|(\\.)|(/)).+sh$" with "tinmop" open ".gpub$" with "tinmop" diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp index 2ee6a5b..a5846ca 100644 --- a/src/gemini-viewer.lisp +++ b/src/gemini-viewer.lisp @@ -389,8 +389,7 @@ (ui:open-gemini-message-link-window :give-focus nil)))) (maybe-render-preformat-wrapper (file-stream wrapper-object) (when (not gemini-format-p) - (gemini-parser:with-initialized-parser - (let* ((preformat-line (format nil "~a~%" gemini-parser:+preformatted-prefix+)) + (let* ((preformat-line (format nil "~a~%" gemini-parser:+preformatted-prefix+)) (parsed-line (gemini-parser:parse-gemini-file preformat-line))) (setf (parsed-lines wrapper-object) (append (parsed-lines wrapper-object) @@ -400,7 +399,7 @@ wrapper-object t))) (maybe-render-line preformat-wrapper-event) - (write-sequence preformat-line file-stream)))))) + (write-sequence preformat-line file-stream))))) (array->string (array remove-bom) (let ((res (text-utils:to-s array :errorp nil))) (if (and (string-not-empty-p res) diff --git a/src/gui/server/main-window-server-side.lisp b/src/gui/server/main-window-server-side.lisp index 286bade..41188f2 100644 --- a/src/gui/server/main-window-server-side.lisp +++ b/src/gui/server/main-window-server-side.lisp @@ -17,20 +17,49 @@ (in-package :json-rpc-communication) -(defclass gemini-window () - ((metadata - :initform nil - :initarg :metadata - :accessor metadata))) +(defclass gemini-window (metadata-container) + ((links-tour + :initform '() + :initarg :links-tour + :accessor links-tour))) + +(defgeneric shuffle-tour (object)) + +(defgeneric add-tour-link (object link)) + +(defgeneric pop-tour-link (object)) + +(defgeneric delete-tour-link-element (object handle)) + +(defgeneric clear-tour-link (object)) + +(defmethod shuffle-tour ((object gemini-window)) + (setf (links-tour object) (misc:shuffle (links-tour object))) + object) + +(defmethod add-tour-link ((object gemini-window) (link string)) + (with-accessors ((links-tour links-tour)) object + (a:reversef links-tour) + (push link links-tour) + (a:reversef links-tour) + object)) + +(defmethod add-tour-link ((object gemini-window) (link gemini-parser:gemini-link)) + (add-tour-link object (gemini-parser:target link))) + +(defmethod pop-tour-link ((object gemini-window)) + (pop (links-tour object))) + +(defmethod delete-tour-link-element ((object gemini-window) url) + (with-accessors ((links-tour links-tour)) object + (setf links-tour (remove url links-tour :test #'string=)))) + +(defmethod clear-tour-link ((object gemini-window)) + (with-accessors ((links-tour links-tour)) object + (setf links-tour '()))) (defparameter *gemini-window* nil) -(defmethod message-window:metadata ((object gemini-window)) - (slot-value object 'metadata)) - -(defmethod (setf message-window:metadata) (value (object gemini-window)) - (setf (slot-value object 'metadata) value)) - (defun init-gemini-window () (setf *gemini-window* (make-instance 'gemini-window)) diff --git a/src/main.lisp b/src/main.lisp index 44a7528..f07e9fb 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -125,9 +125,10 @@ etc.) happened" (format *error-output* "~a~%" e) (os-utils:exit-program 1))) (handler-bind ((error - #'(lambda (e) + (lambda (e) (format *error-output* - (_ "Non fatal error~%~a~%Tinmop will add an empty file for you. This file will be enough to use the program as a gemini client but to connect to pleroma the file must be properly filled.~%Consult the manpage ~a(1) for more details") + (_ "Non fatal error~%~a~%Tinmop will add an empty file for you in ~a. This file will be enough to use the program as a gemini client but to connect to pleroma the file must be properly filled.~%Consult the manpage ~a(1) for more details") + (res:home-confdir) e +program-name+) (invoke-restart 'res:create-empty-in-home)))) @@ -236,6 +237,20 @@ etc.) happened" (client:authorize) (load command-line:*script-file* :verbose nil :print nil))) +(defun rpc-client-load-configuration () + (handler-bind ((error + (lambda (e) + (format *error-output* + (_ "Fatal error~%~a~%Tinmop is unable to find a configuration for the graphical user interface (GUI). Maybe the software need to be updated or reinstalled. Please, fill the empty config file this program just created for you under ~a, or contact your system administrator") + e + (res:home-confdir)) + (invoke-restart 'res:create-empty-in-home)))) + (swconf:load-config-file swconf:+conf-filename+))) + +(defun rpc-client-init () + (shared-init) + (rpc-client-load-configuration)) + (defun main () "The entry point function of the program" (let ((first-time-starting (not (db-utils:db-file-exists-p)))) @@ -248,6 +263,7 @@ etc.) happened" (rpc-server-init) (json-rpc-communication:start-server))) (command-line:*rpc-client-mode* + (rpc-client-load-configuration) (json-rpc-communication:start-client)) (command-line:*print-lisp-dependencies* (misc:all-program-dependencies t)) diff --git a/src/message-window.lisp b/src/message-window.lisp index 81b993a..669d9ba 100644 --- a/src/message-window.lisp +++ b/src/message-window.lisp @@ -23,15 +23,12 @@ (defclass message-window (wrapper-window row-oriented-widget focus-marked-window + metadata-container title-window) ((line-position-mark :initform (make-tui-string "0") :initarg :line-position-mark :accessor line-position-mark) - (metadata - :initform nil - :initarg :metadata - :accessor metadata) (adjust-rows-strategy :initform #'adjust-rows-noop :initarg :adjust-rows-strategy diff --git a/src/misc-utils.lisp b/src/misc-utils.lisp index 9429c0b..b60cdfe 100644 --- a/src/misc-utils.lisp +++ b/src/misc-utils.lisp @@ -34,6 +34,12 @@ (in-package :misc-utils) +(defclass metadata-container () + ((metadata + :initform nil + :initarg :metadata + :accessor metadata))) + ;; debug utils (defparameter *debug* nil) diff --git a/src/package.lisp b/src/package.lisp index 4a92caf..badbfff 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -124,6 +124,8 @@ :constants) (:nicknames :misc) (:export + :metadata-container + :metadata :when-debug :debug-log :dbg @@ -1144,62 +1146,163 @@ (:export :+conf-filename+ :+shared-conf-filename+ + :+key-unknown+ + :+key-experimental+ + :+key-regex+ :+key-background+ :+key-foreground+ - :+key-width+ + :+key-title+ + :+key-start+ + :+key-end+ + :+key-left+ + :+key-right+ + :+key-geometry+ + :+key-tile+ + :+key-stopper+ :+key-root+ + :+key-width+ :+key-height+ - :+key-value+ - :+key-new-message-mark+ + :+key-position+ + :+key-exclusive+ + :+key-search+ + :+key-mode+ + :+key-count+ + :+key-toc+ + :+key-downloading+ + :+key-animation+ + :+key-x+ + :+key-y+ + :+key-error+ + :+key-info+ :+key-window+ + :+key-header+ :+key-focus+ + :+key-prefix+ + :+key-postfix+ + :+key-line+ + :+key-padding+ + :+key-value+ + :+key-scheme+ + :+key-uri+ + :+key-link+ + :+key-links+ + :+key-http+ + :+key-creation-time+ + :+key-access-time+ + :+key-visibility+ + :+key-public+ + :+key-unlisted+ + :+key-private+ + :+key-direct+ + :+key-quote+ + :+key-h1+ + :+key-h2+ + :+key-h3+ + :+key-bullet+ + :+key-preformatted-text+ + :+key-other+ + :+key-attribute+ + :+key-new-message+ :+key-mark+ :+key-vote-vertical-bar+ - :+key-info-dialog+ - :+key-help-dialog+ + :+key-crypted+ + :+key-open-link-helper+ + :+key-histogram+ :+key-error-dialog+ + :+key-info-dialog+ :+key-input-dialog+ + :+key-help-dialog+ :+key-notify-window+ :+key-gempub-library-window+ - :+key-notification-life+ + :+key-notification-icon+ + :+key-life+ + :+key-quick-help+ + :+key-more-choices+ :+key-modeline+ :+key-date-format+ + :+key-locked+ + :+key-unlocked+ + :+key-account+ + :+key-signature-file+ :+key-main-window+ :+key-thread-window+ :+key-message-window+ - :+key-gopher-window+ :+key-chat-window+ :+key-chats-list-window+ :+key-gemini-subscription-window+ :+key-gemini-toc-window+ + :+key-gopher-window+ + :+key-attachment-header+ + :+key-max-numbers-allowed-attachments+ + :+key-max-message-length+ + :+key-max-report-comment-length+ + :+key-reply-quoted-character+ + :+key-line-position-mark+ :+key-favourite+ :+key-sensitive+ :+key-boosted+ :+key-tags-window+ + :+key-conversations-window+ + :+key-keybindings-window+ + :+key-suggestions-window+ :+key-open-attach-window+ :+key-open-message-link-window+ :+key-open-gemini-stream-window+ :+key-gemini-certificates-window+ - :+key-conversations-window+ - :+key-keybindings-window+ - :+key-suggestions-window+ :+key-command-window+ :+key-file-explorer+ + :+key-command-separator+ + :+key-gemini+ + :+key-gemlog+ + :+key-gempub+ + :+key-library+ + :+key-sync+ + :+key-favicon+ + :+key-tree+ + :+key-branch+ + :+key-arrow+ + :+key-left-arrow+ + :+key-data+ + :+key-data-leaf+ + :+key-leaf+ + :+key-branch+ + :+key-spacer+ + :+key-vertical-line+ :+key-editor+ :+key-username+ :+key-server+ :+key-message+ :+key-selected+ + :+key-unselected+ :+key-deleted+ + :+key-fetched+ + :+key-delete+ + :+key-input+ :+key-read+ :+key-unread+ + :+key-directory-symbol+ + :+key-directory+ + :+key-file+ + :+key-binary-file+ + :+key-text-file+ + :+key-image-file+ + :+key-images+ + :+key-gif-file+ + :+key-fetch+ + :+key-update+ + :+key-iri+ + :+key-fragment+ + :+key-close-after-select+ + :+key-password-echo-character+ :+key-color-re+ - :+key-tree+ - :+key-branch+ - :+key-arrow+ - :+key-data+ - :+key-data-leaf+ + :+key-ignore-user-re+ + :+key-ignore-user-boost-re+ + :+key-ignore-tag-re+ + :+key-post-allowed-language+ :+key-purge-history-days-offset+ + :+key-purge-cache-days-offset+ + :+key-mentions+ + :+key-montage+ :+buffer-minimum-size-to-open+ :*allowed-status-visibility* :*allowed-attachment-type* @@ -1209,9 +1312,13 @@ :color-name :color-value :attributes + :parse-config :parse :perform-missing-value-check :load-config-file + :gen-simple-access + :access-non-null-conf-value + :false-value-p :external-editor :gemini-downloading-animation :close-link-window-after-select-p @@ -3075,7 +3182,7 @@ :constants :text-utils :misc-utils) - (:local-nicknames (:re :cl-ppcre-unicode) + (:local-nicknames (:re :cl-ppcre) (:a :alexandria) (:rpc :json-rpc2) (:json :yason) @@ -3087,6 +3194,38 @@ :start-server :start-client)) +(defpackage :client-configuration + (:use + :cl + :config + :constants + :text-utils + :misc-utils) + (:local-nicknames (:re :cl-ppcre) + (:a :alexandria)) + (:export + :+client-conf-filename+ + :gemini-downloading-animation + :gemini-default-favicon + :gemini-fetch-favicon-p + :gemini-text-font-configuration + :gemini-link-font-configuration + :gemini-quote-font-configuration + :gemini-h1-font-configuration + :gemini-h2-font-configuration + :gemini-h3-font-configuration + :gemini-preformatted-text-font-configuration + :gemini-link-prefix-to-gemini + :gemini-link-prefix-to-other + :gemini-link-prefix-to-http + :gemini-quote-prefix + :gemini-h1-prefix + :gemini-h2-prefix + :gemini-h3-prefix + :gemini-bullet-prefix + :gemini-preformatted-fg + :gemini-toc-padding-char)) + (defpackage :main (:use :cl diff --git a/src/text-utils.lisp b/src/text-utils.lisp index 0070621..3ff7329 100644 --- a/src/text-utils.lisp +++ b/src/text-utils.lisp @@ -163,12 +163,13 @@ (defvar *blanks* '(#\Space #\Newline #\Backspace #\Tab #\Linefeed #\Page #\Return #\Rubout)) -(defgeneric trim-blanks (s)) +(defgeneric trim-blanks (s &optional blanks)) -(defmethod trim-blanks ((s string)) - (string-trim *blanks* s)) +(defmethod trim-blanks ((s string) &optional (blanks *blanks*)) + (string-trim blanks s)) -(defmethod trim-blanks ((s null)) +(defmethod trim-blanks ((s null) &optional (blanks *blanks*)) + (declare (ignore blanks)) s) (defun split-words (text) diff --git a/tinmop.asd b/tinmop.asd index a509c37..6030b34 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -151,6 +151,9 @@ :components ((:file "main-window-server-side") (:file "public-api") (:file "json-rpc-communication"))) + (:module gui-client + :pathname "gui/client" + :components ((:file "client-configuration"))) (:file "main") (:module tests :components ((:file "package")