cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- added language parameter for each post sent.

This commit is contained in:
cage 2023-09-13 15:00:31 +02:00
parent 8486e6eea4
commit ef90f3ad43
8 changed files with 248 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
etc/shared.conf
View File

@ -41,6 +41,11 @@ editor = "nano --locking"
post-allowed-language = ".*"
# default language code por posts sent, the list can be found here:
# https://en.wikipedia.org/wiki/List_of_ISO_639-1_codes
default.post.language = "en"
# update gemlog subscriptions when program starts
# (default 'no', change to 'yes' if desired)
start.update.gemlog = no

5
src/api-client.lisp
View File

@ -502,7 +502,9 @@ database."
in-reply-to-id
attachments
attachments-alt-text
subject visibility)
subject
visibility
language)
"Send a status
- content the actual text of the message
- in-reply-to-id status-id of the message you are replying to (or nil
@ -513,6 +515,7 @@ database."
- visibility one of `swconf:*allowed-status-visibility*'"
(tooter:make-status *client*
content
:language language
:in-reply-to in-reply-to-id
:media (mapcar (lambda (path alt-text)
(tooter:make-media *client*

5
src/complete.lisp
View File

@ -128,7 +128,7 @@ completed) and the common prefix of the completion string."
(defmacro with-simple-complete (function-name all-choices-list-fn)
"Generate a complete function using function-name to build the name
the function and `all-choices-list-fn' as a function that returns a
list af all possible candidtae for completion."
list af all possible candidates for completion."
(with-gensyms (matched)
`(defun ,(misc:format-fn-symbol t "~a" function-name) (hint)
(when-let ((,matched (remove-if-not (starts-with-clsr hint)
@ -269,6 +269,9 @@ list af all possible candidtae for completion."
(with-simple-complete bookmark-section-complete
(lambda () (remove-if #'null (db:bookmark-all-sections))))
(with-simple-complete language-codes
(lambda () constants:+language-codes+))
(defun quote-hint (a)
(cl-ppcre:quote-meta-chars a))

185
src/constants.lisp
View File

@ -174,3 +174,188 @@ General Public License for more details."
(define-constant +internal-path-bookmark+ "bookmark" :test #'string=)
(define-constant +internal-path-gemlogs+ "gemlog" :test #'string=)
(define-constant +language-codes+ '("ab"
"aar"
"af"
"aka"
"sq"
"am"
"ara"
"an"
"hy"
"as"
"ava"
"ae"
"aym"
"az"
"bm"
"ba"
"eus"
"be"
"bn"
"bi"
"bs"
"bre"
"bg"
"my"
"an"
"ch"
"ce"
"ny"
"zh"
"cu"
"cv"
"kw"
"co"
"cre"
"hr"
"ces"
"dan"
"dv"
"nl"
"dz"
"en"
"eo"
"et"
"ewe"
"fo"
"fij"
"fi"
"fra"
"fy"
"ful"
"gd"
"gl"
"lug"
"ka"
"deu"
"el"
"kl"
"gn"
"gu"
"ht"
"hau"
"heb"
"her"
"hin"
"ho"
"hu"
"is"
"ido"
"ibo"
"id"
"ia"
"ie"
"iu"
"ik"
"gle"
"it"
"ja"
"jv"
"kn"
"kau"
"ks"
"kaz"
"km"
"ki"
"rw"
"ky"
"kom"
"kon"
"kor"
"ma"
"ku"
"lao"
"lat"
"lv"
"li"
"ln"
"lt"
"lu"
"lb"
"mk"
"mg"
"msa"
"ml"
"mt"
"glv"
"mri"
"mr"
"mh"
"mn"
"nau"
"nv"
"nd"
"nr"
"ndo"
"nep"
"no"
"nb"
"nn"
"ii"
"oc"
"oji"
"ori"
"orm"
"os"
"pli"
"ps"
"fa"
"pol"
"pt"
"pa"
"qu"
"ro"
"rm"
"run"
"ru"
"se"
"smo"
"sag"
"sa"
"sc"
"sr"
"sna"
"snd"
"se"
"slk"
"sl"
"som"
"st"
"an"
"su"
"sw"
"ssw"
"sv"
"tl"
"ty"
"tgk"
"tam"
"tat"
"tel"
"tha"
"bo"
"ti"
"to"
"tso"
"tsn"
"tr"
"tk"
"twi"
"ug"
"uk"
"urd"
"uzb"
"ven"
"vi"
"vo"
"wa"
"cym"
"wol"
"xho"
"yi"
"yor"
"za"
"zul")
:test #'equalp)

6
src/package.lisp
View File

@ -75,6 +75,7 @@
:+internal-scheme+
:+internal-path-bookmark+
:+internal-path-gemlogs+
:+language-codes+
;; GUI
:+minimum-padding+
:+ps-file-dialog-filter+
@ -1432,6 +1433,7 @@
:config-gopher-line-prefix-search-index
:config-gopher-line-prefix-attribute
:config-gopher-line-prefix-foreground
:config-default-post-language
:link-regex->program-to-use
:link-regex->program-to-use-buffer-size
:use-tinmop-as-external-program-p
@ -1597,7 +1599,8 @@
:complete-chat-message
:complete-always-empty
:bookmark-section-complete
:bookmark-description-complete-clsr))
:bookmark-description-complete-clsr
:language-codes))
(defpackage :program-events
(:use
@ -2657,6 +2660,7 @@
(:local-nicknames (:c :croatoan))
(:export
:message-ready-to-send
:language
:subject
:attachments
:reply-to

24
src/sending-message.lisp
View File

@ -19,7 +19,11 @@
(define-constant +header-send-window-height+ 5 :test #'=)
(defclass message-ready-to-send ()
((subject
((language
:initform nil
:initarg :language
:accessor language)
(subject
:initform nil
:initarg :subject
:accessor subject)
@ -107,7 +111,8 @@
(body body)
(subject subject)
(mentions mentions)
(visibility visibility)) message-data
(visibility visibility)
(language language)) message-data
(with-croatoan-window (croatoan-window object)
(let* ((bgcolor (c:bgcolor croatoan-window))
(fgcolor (c:fgcolor croatoan-window))
@ -120,14 +125,17 @@
(label-mentions-raw (_ "Mentions: "))
(label-subject-raw (_ "Subject: "))
(label-visibility-raw (_ "Visibility: "))
(label-language-raw (_ "Language: "))
(label-reply-length-raw (length label-reply-raw))
(label-mentions-length-raw (length label-mentions-raw))
(label-subject-raw-length (length label-subject-raw))
(label-visibility-raw-length (length label-visibility-raw))
(label-language-raw-length (length label-language-raw))
(max-field-length (max label-reply-length-raw
label-mentions-length-raw
label-subject-raw-length
label-visibility-raw-length))
label-visibility-raw-length
label-language-raw-length))
(label-subject (text-utils:right-padding label-subject-raw
max-field-length))
(label-reply (text-utils:right-padding label-reply-raw
@ -136,6 +144,8 @@
max-field-length))
(label-visibility (text-utils:right-padding label-visibility-raw
max-field-length))
(label-language (text-utils:right-padding label-language-raw
max-field-length))
(value-max-length (- (win-width-no-border object)
max-field-length))
(label-attachments (_ "Attachments")))
@ -171,11 +181,17 @@
max-field-length
4
input-bg input-fg)
(print-field label-language 1 5 bgcolor fgcolor)
(print-field (right-padding language
value-max-length)
max-field-length
5
input-bg input-fg)
(print-field (right-padding (text-ellipsis label-attachments
(win-width-no-border object))
(win-width-no-border object))
1
5
6
bgcolor fgcolor
:inverse t)))))))

15
src/software-configuration.lisp
View File

@ -480,7 +480,8 @@
,@(loop for name in names collect
`(gen-key-constant ,name))))
(gen-key-constants unknown
(gen-key-constants default
unknown
experimental
regex
background
@ -635,6 +636,8 @@
ignore-user-boost-re
ignore-tag-re
post-allowed-language
post
language
purge-history-days-offset
purge-cache-days-offset
mentions
@ -1592,6 +1595,13 @@
window-key
+key-input+
+key-foreground+))))
(gen-simple-access (default-post-language
:transform-value-fn identity)
+key-default+
+key-post+
+key-language+)
;;;;;; tests
(defun trivial-configuration-missing-value-check ()
@ -1619,6 +1629,7 @@
#'message-window-unlocked-account-mark
#'message-window-line-mark-values
#'message-window-attachments-header
#'config-post-allowed-language)
#'config-post-allowed-language
#'config-default-post-language)
do
(funcall fn)))

13
src/ui-goodies.lisp
View File

@ -1376,6 +1376,17 @@ It an existing file path is provided the command will refuse to run."
:direction :output
:element-type 'character)
(format stream "~a~%" message-header-text))))
(add-language ()
(flet ((on-add-language (language-code)
(setf (sending-message:language *message-to-send*)
language-code)
(if (member language-code +language-codes+ :test #'string=)
(add-subject)
(add-language))))
(ask-string-input #'on-add-language
:initial-value (swconf:config-default-post-language)
:prompt (_ "Add language of the post: ")
:complete-fn #'complete:language-codes)))
(add-body ()
(let ((temp-file (fs:temporary-file)))
(insert-header-text temp-file)
@ -1392,7 +1403,7 @@ It an existing file path is provided the command will refuse to run."
reference-open-file))
(let ((body (fs:slurp-file temp-file)))
(setf (sending-message:body *message-to-send*) body)
(add-subject)))))))
(add-language)))))))
(add-body)))
(defun actual-author-message-id (message-row)