diff --git a/etc/shared.conf b/etc/shared.conf index 0cd2504..c26de9f 100644 --- a/etc/shared.conf +++ b/etc/shared.conf @@ -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 diff --git a/src/api-client.lisp b/src/api-client.lisp index db37eaa..80135da 100644 --- a/src/api-client.lisp +++ b/src/api-client.lisp @@ -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* diff --git a/src/complete.lisp b/src/complete.lisp index c03bec0..9fad824 100644 --- a/src/complete.lisp +++ b/src/complete.lisp @@ -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)) diff --git a/src/constants.lisp b/src/constants.lisp index 9bf8070..e411bff 100644 --- a/src/constants.lisp +++ b/src/constants.lisp @@ -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) diff --git a/src/package.lisp b/src/package.lisp index ba74bb5..91db76d 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/sending-message.lisp b/src/sending-message.lisp index e02c1fc..8dec619 100644 --- a/src/sending-message.lisp +++ b/src/sending-message.lisp @@ -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))))))) diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index dd25ed1..fb94d00 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -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))) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 9c062a3..3f48c11 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -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)