cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2024-12-23 23:51:50 +01:00
Code Issues

- added a welcome window.

Browse Source
This commit is contained in:
cage 2021-07-03 12:34:05 +02:00
parent 00b3a2d947
commit 91bae49372
7 changed files with 88 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
etc/default-theme.conf
View File

@ -54,17 +54,17 @@ directory-symbol = "🗀"
# quick help window style
quick-help.header.foreground = white
quick-help.header.foreground = black
quick-help.header.background = red
quick-help.header.background = cyan
quick-help.header.attribute = bold
# help dialog style
help-dialog.background = white
help-dialog.background = black
help-dialog.foreground = red
help-dialog.foreground = cyan
# info dialog style

22
src/command-window.lisp
View File

@ -193,17 +193,17 @@ be either `:keybinding' or `:string'. the former for key command the latter for
:bgcolor point-bg)))))
(defmethod draw ((object command-window))
(with-accessors ((command-line command-line)
(commands-separator commands-separator)
(error-message-bg error-message-bg)
(error-message-fg error-message-fg)
(error-message-attributes error-message-attributes)
(error-message error-message)
(info-message-bg info-message-bg)
(info-message-fg info-message-fg)
(info-message info-message)
(info-message-attributes info-message-attributes)
(suggestions-win suggestions-win)) object
(with-accessors ((command-line command-line)
(commands-separator commands-separator)
(error-message-bg error-message-bg)
(error-message-fg error-message-fg)
(error-message-attributes error-message-attributes)
(error-message error-message)
(info-message-bg info-message-bg)
(info-message-fg info-message-fg)
(info-message info-message)
(info-message-attributes info-message-attributes)
(suggestions-win suggestions-win)) object
(when suggestions-win
(draw suggestions-win))
(win-clear object :redraw nil)

38
src/constants.lisp
View File

@ -41,6 +41,44 @@ For bug report please point your browser to:
+issue-tracker+)
:test #'string=)
(define-constant +welcome-message+
(format nil
"
_______
/_ __(_)___ ____ ___ ____ ____
/ / / / __ \\/ __ `__ \\/ __ \\/ __ \\
/ / / / / / / / / / / / /_/ / /_/ /
/_/ /_/_/ /_/_/ /_/ /_/\\____/ .___/
/_/
Welcome to ~a! A gemini and pleroma client.
- for available keychords (sequence of keys to fire a command) help type '?';
- for searching in the help type: 'C-h a' (control and 'h' keys toghether, then 'a');
[if this keychords does not works, ask to your system administrator]
- documentation is available in man format. Type 'man tinmop' at shell's prompt;
- for general information about this program (including license) type 'C-a';
- if you need more help or for bug report: ~a
(collaborations are welcome too!).
Enjoy!
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."
(if (string= +program-name+ "tinmop")
"tinmop"
(format nil "~a (original name: \"tinmop\")" +program-name+))
+issue-tracker+)
:test #'string=)
(define-constant +http-code-ok+ 200 :test #'=)
(define-constant +mime-type-jpg+ "image/jpeg" :test #'string=)

5
src/db-utils.lisp
View File

@ -233,9 +233,12 @@ example:
"/"
+db-file+)))
(defun db-file-exists-p ()
(fs:file-exists-p (db-path)))
(defun init-connection ()
"Initialize a db connection (and create db file if does not exists)"
(when (not (fs:file-exists-p (db-path)))
(when (not (db-file-exists-p))
(fs:create-file (db-path)))
(setf *connection* (sqlite:connect (db-path))))

27
src/main.lisp
View File

@ -171,12 +171,14 @@ etc.) happened"
(when command-line:*check-follow-requests*
(ui:start-follow-request-processing))))))
(defun run ()
(defun run (draw-welcome-string)
(windows:with-croatoan-window (croatoan-window specials:*main-window*)
(setf (frame-rate croatoan-window) +fps+)
(db-utils:with-ready-database (:connect nil)
(unwind-protect
(progn
(when draw-welcome-string
(ui:show-welcome-window))
(hooks:run-hooks 'hooks:*before-main-loop*)
(run-event-loop croatoan-window))
(end-screen)))))
@ -192,14 +194,15 @@ etc.) happened"
(defun main ()
"The entry point function of the program"
(init-i18n)
(res:init)
(command-line:manage-opts)
(if command-line:*script-file*
(load-script-file)
(let ((croatoan::*debugger-hook* #'(lambda (c h)
(declare (ignore h))
(end-screen)
(print c))))
(init)
(run))))
(let ((first-time-starting (not (db-utils:db-file-exists-p))))
(init-i18n)
(res:init)
(command-line:manage-opts)
(if command-line:*script-file*
(load-script-file)
(let ((croatoan::*debugger-hook* #'(lambda (c h)
(declare (ignore h))
(end-screen)
(print c))))
(init)
(run first-time-starting)))))

3
src/package.lisp
View File

@ -43,6 +43,7 @@
:config)
(:export
:+help-about-message+
:+welcome-message+
:+http-code-ok+
:+mime-type-jpg+
:+mime-type-png+
@ -722,6 +723,7 @@
:with-db-transaction
:db-path
:quote-symbol
:db-file-exists-p
:init-connection
:with-ready-database
:with-disabled-foreign
@ -2514,6 +2516,7 @@
:crypto-export-key
:crypto-generate-key
:show-about-window
:show-welcome-window
:reset-timeline-pagination
:poll-vote
:refresh-chats

13
src/ui-goodies.lisp
View File

@ -1567,6 +1567,19 @@ certificate).
lines
bg
fg)))
(defun show-welcome-window ()
"Show an informative window about this program"
(let ((lines (text-utils:split-lines +welcome-message+))
(bg (swconf:win-bg swconf:+key-help-dialog+))
(fg (swconf:win-fg swconf:+key-help-dialog+)))
(windows:make-blocking-message-dialog *main-window*
nil
(_ "Welcome")
lines
bg
fg)))
(defun reset-timeline-pagination ()
"Removes the pagination data for current timeline and folder