1
0
Fork 0
tinmop/src/main.lisp

297 lines
12 KiB
Common Lisp
Raw Normal View History

;; tinmop: a multiprotocol client
2023-10-19 17:46:22 +02:00
;; Copyright © cage
2020-05-08 15:45:43 +02:00
;; 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)
2020-05-08 15:45:43 +02:00
(define-constant +dt+ (/ 1 +fps+) :test #'=)
(defun incf-dt ()
(incf *time* +dt+))
(defun incf-ticks ()
(incf *ticks*))
2020-05-08 15:45:43 +02:00
(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
2020-05-08 15:45:43 +02:00
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+)))))))
2020-05-08 15:45:43 +02:00
(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)))
2020-05-08 15:45:43 +02:00
(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*)))))
2020-05-08 15:45:43 +02:00
(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*
2024-03-30 20:34:16 +01:00
(_ "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 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)
2020-05-08 15:45:43 +02:00
"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))))
2020-05-08 15:45:43 +02:00
;; 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))
2020-05-08 15:45:43 +02:00
;; 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*)
2020-05-08 15:45:43 +02:00
(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))))))
2020-05-08 15:45:43 +02:00
(defun run ()
2020-05-08 15:45:43 +02:00
(windows:with-croatoan-window (croatoan-window specials:*main-window*)
(setf (c:frame-rate croatoan-window) +fps+)
2020-05-08 15:45:43 +02:00
(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)))))
2020-05-08 15:45:43 +02:00
(defun load-script-file ()
"Load (execute) a lisp file used in requests of a command line switch"
2020-05-08 15:45:43 +02:00
(setf program-events:*process-events-immediately* t)
(shared-init)
2020-05-08 15:45:43 +02:00
(db-utils:with-ready-database (:connect nil)
(when (not *gemini-full-screen-mode*)
(client:init)
(client:authorize))
2020-05-08 15:45:43 +02:00
(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))
2020-05-08 15:45:43 +02:00
(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))))))