mirror of https://codeberg.org/cage/tinmop/
Compare commits
4 Commits
5fc9921df3
...
bbca3c8a31
Author | SHA1 | Date |
---|---|---|
cage | bbca3c8a31 | |
cage | 0e14ee91f7 | |
cage | 1d4d813dbc | |
cage | 917af9b007 |
|
@ -666,6 +666,9 @@ delete-and-move-previous
|
|||
\fBN d \fP
|
||||
delete-notifications
|
||||
.TP
|
||||
\fBT d \fP
|
||||
thread-delete-subtree
|
||||
.TP
|
||||
\fBP \fP
|
||||
poll-vote
|
||||
.TP
|
||||
|
|
|
@ -378,6 +378,7 @@
|
|||
- M :: print-mentions
|
||||
- M-u :: delete-and-move-previous
|
||||
- N d :: delete-notifications
|
||||
- T d :: thread-delete-subtree
|
||||
- P :: poll-vote
|
||||
- p :: show-parent-post
|
||||
- U :: thread-mark-prevent-delete-selected-message
|
||||
|
|
|
@ -337,6 +337,8 @@
|
|||
|
||||
(define-key "N d" #'delete-notifications *thread-keymap*)
|
||||
|
||||
(define-key "T d" #'thread-delete-subtree *thread-keymap*)
|
||||
|
||||
(define-key "P" #'poll-vote *thread-keymap*)
|
||||
|
||||
(define-key "p" #'show-parent-post *thread-keymap*)
|
||||
|
|
|
@ -89,6 +89,11 @@
|
|||
:meta-var (_ "MODULE-FILE")
|
||||
:arg-parser #'identity
|
||||
:long "load-module")
|
||||
(:name :fediverse-account
|
||||
:description (_ "Specify a fediverse user account (format: user-name@server-name).")
|
||||
:meta-var (_ "FEDIVERSE-ACCOUNT")
|
||||
:arg-parser #'identity
|
||||
:long "fediverse-account")
|
||||
(:name :print-lisp-dependencies
|
||||
:description (_ "Download lisp libraries (useful for packaging only).")
|
||||
:short #\X
|
||||
|
@ -133,6 +138,8 @@
|
|||
|
||||
(defparameter *start-dummy-server* nil)
|
||||
|
||||
(defparameter *fediverse-account* nil)
|
||||
|
||||
(defun exit-on-error (e)
|
||||
(format *error-output* "~a~%" e)
|
||||
(os-utils:exit-program 1))
|
||||
|
@ -177,6 +184,11 @@
|
|||
(write-shell-array options)))
|
||||
(write-shell-array options))))))
|
||||
|
||||
(defun fediverse-account-parameters ()
|
||||
(when-let ((splitted (cl-ppcre:split "@" *fediverse-account*)))
|
||||
(values (elt splitted 0)
|
||||
(elt splitted 1))))
|
||||
|
||||
(defun manage-opts ()
|
||||
(handler-bind ((opts:unknown-option #'exit-on-error)
|
||||
(opts:missing-arg #'exit-on-error)
|
||||
|
@ -204,6 +216,7 @@
|
|||
(set-option-variable options :update-timeline *update-timeline*)
|
||||
(set-option-variable options :execute *script-file*)
|
||||
(set-option-variable options :load-module *module-file*)
|
||||
(set-option-variable options :fediverse-account *fediverse-account*)
|
||||
(set-option-variable options :check-follows-requests *check-follow-requests*)
|
||||
(set-option-variable options :gemini-full-screen-mode *gemini-full-screen-mode*)
|
||||
(set-option-variable options :notify-mentions *notify-mentions*)
|
||||
|
|
|
@ -123,7 +123,11 @@ General Public License for more details."
|
|||
(define-constant +mime-type-text+ "text/plain" :test #'string=)
|
||||
|
||||
(define-constant +db-file-extension+ "sqlite3" :test #'string=
|
||||
:documentation "the extension filename of the databases")
|
||||
:documentation "the extension filename of the databases")
|
||||
|
||||
(define-constant +default-database-username+ "default" :test #'string=)
|
||||
|
||||
(define-constant +default-database-server-name+ "default" :test #'string=)
|
||||
|
||||
(define-constant +json-true+ "true" :test #'string=)
|
||||
|
||||
|
|
|
@ -227,29 +227,34 @@ example:
|
|||
(from table)))))
|
||||
:ct))
|
||||
|
||||
(defun db-current-file-name ()
|
||||
(defun db-file-name (username server-name)
|
||||
(concatenate 'string
|
||||
(swconf:current-username)
|
||||
username
|
||||
"@"
|
||||
(swconf:current-server-name)
|
||||
server-name
|
||||
"."
|
||||
+db-file-extension+))
|
||||
|
||||
(defun db-path ()
|
||||
(uiop:unix-namestring (concatenate 'string
|
||||
(res:home-datadir)
|
||||
"/"
|
||||
(db-current-file-name))))
|
||||
(defun db-current-file-name ()
|
||||
(db-file-name (swconf:current-username)
|
||||
(swconf:current-server-name)))
|
||||
|
||||
(defun db-path* ()
|
||||
(defun db-path (&optional (file-name (db-current-file-name)))
|
||||
(uiop:unix-namestring (concatenate 'string
|
||||
(res:home-datadir)
|
||||
"/"
|
||||
"db.sqlite3")))
|
||||
file-name)))
|
||||
|
||||
(defun db-file-exists-p ()
|
||||
(fs:file-exists-p (db-path)))
|
||||
|
||||
(defun a-database-file-exists-p (usernames server-names)
|
||||
(loop for username in usernames
|
||||
for server-name in server-names do
|
||||
(when (fs:file-exists-p (db-path (db-file-name username server-name)))
|
||||
(return-from a-database-file-exists-p t)))
|
||||
nil)
|
||||
|
||||
(defun init-connection ()
|
||||
"Initialize a db connection (and create db file if does not exists)"
|
||||
(when (not (db-file-exists-p))
|
||||
|
|
|
@ -125,9 +125,11 @@ etc.) happened"
|
|||
(format *error-output* "~a~%" e)
|
||||
(os-utils:exit-program 1)))
|
||||
(handler-case
|
||||
(progn
|
||||
(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))
|
||||
(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 pleroma 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.~%")
|
||||
|
@ -138,10 +140,11 @@ etc.) happened"
|
|||
(res:create-empty-file-in-home swconf:+conf-filename+)
|
||||
(os-utils:exit-program 1))))
|
||||
|
||||
(defun shared-init (&key (verbose t))
|
||||
(defun shared-init (&key (verbose t) (initialize-database t))
|
||||
(num:lcg-set-seed)
|
||||
(load-configuration-files :verbose verbose)
|
||||
(init-db))
|
||||
(when initialize-database
|
||||
(init-db)))
|
||||
|
||||
(defun rpc-server-init ()
|
||||
"Initialize the program"
|
||||
|
@ -155,9 +158,8 @@ etc.) happened"
|
|||
command-line:*module-file*))))
|
||||
(json-rpc-communication:start-server)))
|
||||
|
||||
(defun tui-init ()
|
||||
(defun tui-init (draw-welcome-window)
|
||||
"Initialize the program"
|
||||
(shared-init)
|
||||
(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+
|
||||
|
@ -173,6 +175,8 @@ etc.) happened"
|
|||
(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
|
||||
|
@ -220,14 +224,12 @@ etc.) happened"
|
|||
(when command-line:*check-follow-requests*
|
||||
(ui:start-follow-request-processing))))))
|
||||
|
||||
(defun run (draw-welcome-string)
|
||||
(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
|
||||
(when draw-welcome-string
|
||||
(ui:show-welcome-window))
|
||||
(hooks:run-hooks 'hooks:*before-main-loop*)
|
||||
(c:run-event-loop croatoan-window))
|
||||
(c:end-screen)))))
|
||||
|
@ -280,7 +282,11 @@ etc.) happened"
|
|||
(declare (ignore h))
|
||||
(c:end-screen)
|
||||
(print c))))
|
||||
|
||||
(tui-init)
|
||||
(let ((first-time-starting (not (db-utils:db-file-exists-p))))
|
||||
(run first-time-starting))))))
|
||||
(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))))))
|
||||
|
|
|
@ -56,6 +56,8 @@
|
|||
:+mime-type-html+
|
||||
:+mime-type-text+
|
||||
:+db-file-extension+
|
||||
:+default-database-username+
|
||||
:+default-database-server-name+
|
||||
:+fps+
|
||||
:+command-window-height+
|
||||
:+starting-init-file+
|
||||
|
@ -832,6 +834,7 @@
|
|||
:db-path
|
||||
:quote-symbol
|
||||
:db-file-exists-p
|
||||
:a-database-file-exists-p
|
||||
:init-connection
|
||||
:with-ready-database
|
||||
:with-disabled-foreign
|
||||
|
@ -1570,6 +1573,7 @@
|
|||
:*start-dummy-server*
|
||||
:*rpc-server-mode*
|
||||
:*rpc-client-mode*
|
||||
:fediverse-account-parameters
|
||||
:manage-opts))
|
||||
|
||||
(defpackage :specials
|
||||
|
@ -2970,6 +2974,7 @@
|
|||
:thread-open-selected-message
|
||||
:thread-mark-delete-selected-message
|
||||
:thread-mark-prevent-delete-selected-message
|
||||
:thread-delete-subtree
|
||||
:subscribe-to-hash
|
||||
:unsubscribe-to-hash
|
||||
:message-extract-links
|
||||
|
|
|
@ -1136,7 +1136,11 @@
|
|||
(cond
|
||||
((not (or username
|
||||
server-name))
|
||||
(set-currents (first (config-username)) (first (config-server-name))))
|
||||
(if (and (config-username)
|
||||
(config-server-name))
|
||||
(set-currents (first (config-username)) (first (config-server-name)))
|
||||
(set-currents +default-database-username+
|
||||
+default-database-server-name+)))
|
||||
((and (text-utils:string-not-empty-p username)
|
||||
(text-utils:string-not-empty-p server-name))
|
||||
(let* ((position-all-usernames (loop for pos from 0
|
||||
|
|
|
@ -365,6 +365,21 @@ Metadata includes:
|
|||
(thread-window:mark-selected-message-prevent-delete *thread-window*
|
||||
:move-down-selected-message t))
|
||||
|
||||
(defun thread-delete-subtree ()
|
||||
"Mark the selected message and all its children for deletion and do the
|
||||
same to each child of the latter"
|
||||
(with-enqueued-process ()
|
||||
(when-let* ((selected-row (line-oriented-window:selected-row-fields *thread-window*))
|
||||
(selected-message-id (db:row-message-status-id selected-row))
|
||||
(timeline (thread-window:timeline-type *thread-window*))
|
||||
(folder (thread-window:timeline-folder *thread-window*))
|
||||
(messages-tree (db:message-root->tree timeline folder selected-message-id))
|
||||
(children-to-delete (mtree:collect-nodes-data messages-tree))
|
||||
(ids-to-delete (mapcar #'db:row-message-status-id children-to-delete)))
|
||||
(loop for id-to-delete in ids-to-delete do
|
||||
(db:mark-status-deleted timeline folder id-to-delete))
|
||||
(line-oriented-window:resync-rows-db *thread-window* :redraw t))))
|
||||
|
||||
(defun subscribe-to-hash ()
|
||||
"Subscribe to hashtag"
|
||||
(flet ((on-input-complete (tags)
|
||||
|
|
Loading…
Reference in New Issue