mirror of https://codeberg.org/cage/tinmop/
298 lines
12 KiB
Common Lisp
298 lines
12 KiB
Common Lisp
;; tinmop: a multiprotocol client
|
|
;; Copyright © cage
|
|
|
|
;; This program is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program.
|
|
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
|
|
|
|
(in-package :main)
|
|
|
|
(defparameter *time* 0.0)
|
|
|
|
(defparameter *ticks* 0)
|
|
|
|
(define-constant +dt+ (/ 1 +fps+) :test #'=)
|
|
|
|
(defun incf-dt ()
|
|
(incf *time* +dt+))
|
|
|
|
(defun incf-ticks ()
|
|
(incf *ticks*))
|
|
|
|
(defun setup-bindings ()
|
|
"This is where an UI event is bound to a function the event nil is
|
|
the event that is fired when no input from user (key pressed mouse
|
|
etc.) happened"
|
|
(windows:with-croatoan-window (croatoan-window specials:*main-window*)
|
|
(let ((skip-event nil))
|
|
(flet ((manage-keyboard-event (event)
|
|
(incf-dt)
|
|
(handler-bind ((conditions:command-not-found
|
|
(lambda (e)
|
|
(invoke-restart 'command-window:print-error e))))
|
|
(command-window:manage-event event))))
|
|
(c:bind croatoan-window
|
|
:resize
|
|
(lambda (w event)
|
|
(declare (ignore w event))
|
|
(windows:refresh-config-all)
|
|
(windows:draw-all)))
|
|
;; this is an ugly hack for the bug reported here:
|
|
;; https://lists.gnu.org/archive/html/help-ncurses/2022-07/msg00000.html
|
|
;; If someone have an idea how to address the issue drop me a message!
|
|
(c:bind croatoan-window
|
|
#\Esc
|
|
(lambda (w e)
|
|
(declare (ignore w e))
|
|
(setf skip-event t)))
|
|
(c:bind croatoan-window
|
|
t
|
|
(lambda (w event)
|
|
(declare (ignore w))
|
|
(let ((event-key (c:event-key event)))
|
|
(when (not (and skip-event
|
|
(characterp event-key)
|
|
(<= (char-code event-key) 255)))
|
|
(setf skip-event nil)
|
|
(manage-keyboard-event event)))))
|
|
;; this is the main thread
|
|
(c:bind croatoan-window
|
|
nil
|
|
(lambda (w e)
|
|
(declare (ignore w e))
|
|
(incf-dt)
|
|
(incf-ticks)
|
|
(scheduled-events:run-scheduled-events *ticks*)
|
|
(when (not (program-events:stop-event-dispatching-p))
|
|
(program-events:dispatch-program-events))
|
|
(windows:calculate-all +dt+)))))))
|
|
|
|
(defun init-i18n ()
|
|
"Initialize i18n machinery"
|
|
(handler-bind ((error
|
|
(lambda (e)
|
|
(declare (ignore e))
|
|
(invoke-restart 'cl-i18n:return-empty-translation-table))))
|
|
(setf cl-i18n:*translation-file-root* +catalog-dir+)
|
|
(cl-i18n:load-language +text-domain+ :locale (cl-i18n:find-locale))))
|
|
|
|
(defun init-db ()
|
|
"Initialize the database"
|
|
(db-utils:with-ready-database (:connect t)))
|
|
|
|
(defun change-folder ()
|
|
"Change folder, used in requests of a command line switch"
|
|
(let ((refresh-event (make-instance 'program-events:refresh-thread-windows-event
|
|
:new-folder command-line:*start-folder*))
|
|
(folder-exists-p (db:folder-exists-p command-line:*start-folder*)))
|
|
(if folder-exists-p
|
|
(program-events:push-event refresh-event)
|
|
(ui:error-message (format nil
|
|
(_ "Folder ~s does not exists")
|
|
command-line:*start-folder*)))))
|
|
|
|
(defun change-timeline ()
|
|
"Change timeline, used in requests of a command line switch"
|
|
(let* ((refresh-event (make-instance 'program-events:refresh-thread-windows-event
|
|
:new-timeline command-line:*start-timeline*)))
|
|
(program-events:push-event refresh-event)))
|
|
|
|
(defun reset-timeline-pagination ()
|
|
(ui:reset-timeline-pagination))
|
|
|
|
(defun load-configuration-files (&key (verbose t))
|
|
(when (and verbose
|
|
(not command-line:*script-file*))
|
|
(format t
|
|
(_ "Loading configuration file ~a~%")
|
|
swconf:+shared-conf-filename+))
|
|
(handler-case
|
|
(multiple-value-bind (x configuration-file-path)
|
|
(swconf:load-config-file swconf:+shared-conf-filename+)
|
|
(declare (ignore x))
|
|
(swconf:perform-trivial-configuration-checks configuration-file-path))
|
|
(error (e)
|
|
(format *error-output* "~a~%" e)
|
|
(os-utils:exit-program 1)))
|
|
(handler-case
|
|
(multiple-value-bind (command-line-username command-line-server-name)
|
|
(command-line:fediverse-account-parameters)
|
|
(swconf:load-config-file swconf:+conf-filename+ t)
|
|
(swconf:set-current-username-and-server command-line-username
|
|
command-line-server-name))
|
|
(error (e)
|
|
(format *error-output*
|
|
(_ "Configuration error~%~a~%Tinmop will create an empty file for you in ~a (if such file does not exists). This file will be enough to use the program as a gemini client but, to connect to fediverse, the file must be properly filled.~2%Consult the manpage ~a(1) for more details.~2%If you already wrote a configuration file, check the error printed below, try to fix the configuration file and restart ~a.~%")
|
|
e
|
|
(res:home-confdir)
|
|
+program-name+
|
|
+program-name+)
|
|
(res:create-empty-file-in-home (fs:cat-parent-dir (res:home-confdir)
|
|
swconf:+conf-filename+))
|
|
(os-utils:exit-program 1))))
|
|
|
|
(defun shared-init (&key (verbose t) (initialize-database t))
|
|
(num:lcg-set-seed)
|
|
(load-configuration-files :verbose verbose)
|
|
(when initialize-database
|
|
(init-db)))
|
|
|
|
(defun rpc-server-init ()
|
|
"Initialize the program"
|
|
(shared-init :verbose nil)
|
|
(db-utils:with-ready-database (:connect nil)
|
|
(when command-line:*module-file*
|
|
(handler-case
|
|
(modules:load-module command-line:*module-file*)
|
|
(error ()
|
|
(format *error-output* (_ "Unable to load module ~a")
|
|
command-line:*module-file*))))
|
|
(json-rpc-communication:start-server)))
|
|
|
|
(defun tui-init (draw-welcome-window)
|
|
"Initialize the program"
|
|
(db-utils:with-ready-database (:connect nil)
|
|
(complete:initialize-complete-username-cache)
|
|
(let ((system-config-file-found-p (modules:load-sys-module +starting-init-file+
|
|
:not-found-signal-error nil)))
|
|
(multiple-value-bind (home-config-file-found-p error-message)
|
|
(modules:load-module +starting-init-file+ :not-found-signal-error nil)
|
|
(when (not (or system-config-file-found-p
|
|
home-config-file-found-p))
|
|
(croatoan:end-screen)
|
|
(format *error-output* "~a~%" error-message)
|
|
(os-utils:exit-program 1))))
|
|
;; init main window for first...
|
|
(main-window:init)
|
|
(keybindings-window:init)
|
|
(command-window:init)
|
|
(when draw-welcome-window
|
|
(ui:show-welcome-window))
|
|
(when (not command-line:*gemini-full-screen-mode*)
|
|
(thread-window:init))
|
|
;; the size of message and tag window depends from the sizes of
|
|
;; thread-window and command window, so the first two must be
|
|
;; initialized after the latter
|
|
(message-window:init)
|
|
(when (not command-line:*gemini-full-screen-mode*)
|
|
(tags-window:init)
|
|
(conversations-window:init))
|
|
(gemini-client:init-default-gemini-theme specials:*message-window*)
|
|
(setup-bindings)
|
|
;; ... and init-keyboard-mapping-for last
|
|
(keybindings:init-keyboard-mapping)
|
|
(if command-line:*gemini-full-screen-mode*
|
|
(progn
|
|
(ui:display-latest-visited-urls)
|
|
(ui:focus-to-message-window))
|
|
(ui:focus-to-thread-window))
|
|
;; now init the client; we do not check for empty server name
|
|
;; list, as the length of server-names and usernames must be the
|
|
;; same (this rule is enforced by
|
|
;; 'swconf:trivial-configuration-checks')
|
|
(when (not (or *gemini-full-screen-mode*
|
|
(null (swconf::config-username))))
|
|
(client:init)
|
|
(client:authorize))
|
|
(when command-line:*module-file*
|
|
(handler-case
|
|
(modules:load-module command-line:*module-file*)
|
|
(error ()
|
|
(ui:notify (format nil
|
|
(_ "Unable to load module ~a")
|
|
command-line:*module-file*)
|
|
:as-error t))))
|
|
(if command-line:*net-address*
|
|
(progn
|
|
(gemini-page-toc:open-toc-window specials:*message-window*)
|
|
(ui:open-net-address command-line:*net-address*))
|
|
(progn
|
|
(let ((program-events:*process-events-immediately* t))
|
|
(when command-line:*start-timeline*
|
|
(change-timeline))
|
|
(when command-line:*start-folder*
|
|
(change-folder)))
|
|
(when command-line:*reset-timeline-pagination*
|
|
(reset-timeline-pagination))
|
|
(when command-line:*update-timeline*
|
|
(ui:update-current-timeline))
|
|
(when command-line:*check-follow-requests*
|
|
(ui:start-follow-request-processing))))))
|
|
|
|
(defun run ()
|
|
(windows:with-croatoan-window (croatoan-window specials:*main-window*)
|
|
(setf (c:frame-rate croatoan-window) +fps+)
|
|
(db-utils:with-ready-database (:connect nil)
|
|
(unwind-protect
|
|
(progn
|
|
(hooks:run-hooks 'hooks:*before-main-loop*)
|
|
(c:run-event-loop croatoan-window))
|
|
(c:end-screen)))))
|
|
|
|
(defun load-script-file ()
|
|
"Load (execute) a lisp file used in requests of a command line switch"
|
|
(setf program-events:*process-events-immediately* t)
|
|
(shared-init)
|
|
(db-utils:with-ready-database (:connect nil)
|
|
(when (not *gemini-full-screen-mode*)
|
|
(client:init)
|
|
(client:authorize))
|
|
(load command-line:*script-file* :verbose nil :print nil)))
|
|
|
|
(defun rpc-client-load-configuration ()
|
|
(gui-conf:load-config-file gui-conf:+client-sys-conf-filename+)
|
|
(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))))
|
|
(gui-conf:load-config-file)))
|
|
|
|
(defun rpc-client-init ()
|
|
(shared-init)
|
|
(rpc-client-load-configuration))
|
|
|
|
(defun main ()
|
|
"The entry point function of the program"
|
|
(init-i18n)
|
|
(res:init)
|
|
(command-line:manage-opts)
|
|
(cond
|
|
(command-line:*start-dummy-server*
|
|
(gemini-dummy-server:start))
|
|
(command-line:*rpc-server-mode*
|
|
(rpc-server-init))
|
|
(command-line:*rpc-client-mode*
|
|
(rpc-client-init)
|
|
(json-rpc-communication::start-client)
|
|
(client-main-window:init-main-window command-line:*net-address*))
|
|
(command-line:*print-lisp-dependencies*
|
|
(misc:all-program-dependencies t))
|
|
(command-line:*script-file*
|
|
(load-script-file))
|
|
(t
|
|
(let ((croatoan::*debugger-hook* #'(lambda (c h)
|
|
(declare (ignore h))
|
|
(c:end-screen)
|
|
(print c))))
|
|
(shared-init :initialize-database nil)
|
|
(let* ((config-usernames (swconf::config-username))
|
|
(config-server-names (swconf::config-server-name))
|
|
(first-time-starting (not (db-utils:a-database-file-exists-p config-usernames
|
|
config-server-names))))
|
|
(init-db)
|
|
(tui-init first-time-starting)
|
|
(run))))))
|