cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-01-02 01:06:40 +01:00
Code Issues

- fixed checking if a reblogged posts contains a poll;

Browse Source 
- added shell completions for folders and timelines.
This commit is contained in:
cage 2024-10-24 17:35:42 +02:00
parent 7bac005198
commit e073f8e749
3 changed files with 84 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
src/command-line.lisp
View File

@ -153,42 +153,76 @@
(setf ,option-variable ,option-value))))
(defun complete ()
(flet ((write-shell-array (sequence)
(write-sequence (text-utils:join-with-strings sequence " ")
*standard-output*))
(build-options (all-options switch-prefix key)
(let ((compatible-options (mapcar (lambda (a) (getf a key))
(remove-if-not (lambda (a) (getf a key nil))
all-options))))
(mapcar (lambda (a)
(format nil "~a~a" switch-prefix a))
compatible-options))))
(let* ((all-options (options))
(long-options (build-options all-options "--" :long))
(short-options (build-options all-options "-" :short))
(options (nconc long-options short-options))
(words (text-utils:split-words (os-utils:getenv "COMP_WORDS")))
(words-index (ignore-errors (parse-integer (os-utils:getenv "COMP_CWORD"))))
(command-line (os-utils:getenv "COMP_LINE")))
(declare (ignore command-line))
(when (and words
words-index)
(if (< words-index
(length words))
(let ((matched (sort (remove-if-not (lambda (a)
(cl-ppcre:scan (strcat "^"
(elt words
words-index))
a))
options)
(lambda (a b)
(< (length a)
(length b))))))
(if matched
(progn
(write-shell-array matched))
(write-shell-array options)))
(write-shell-array options))))))
(main::shared-init :initialize-database t :verbose nil)
(db-utils:with-ready-database (:connect nil)
(labels ((write-shell-array (sequence)
(write-sequence (text-utils:join-with-strings sequence " ")
*standard-output*))
(build-options (all-options switch-prefix key)
(let ((compatible-options (mapcar (lambda (a) (getf a key))
(remove-if-not (lambda (a) (getf a key nil))
all-options))))
(mapcar (lambda (a)
(format nil "~a~a" switch-prefix a))
compatible-options)))
(remove-unmatched (words index candidates)
(remove-if-not (lambda (a)
(scan (strcat "^"
(elt words
index))
a))
candidates))
(complete-after-switch (words words-index candidates)
(let ((matched (remove-unmatched words
words-index
candidates)))
(if matched
(write-shell-array matched)
(write-shell-array candidates))))
(complete-after-switch-p (words words-index &rest switch-candidates)
(member (elt words (1- words-index))
switch-candidates
:test #'string=)))
(let* ((all-options (options))
(long-options (build-options all-options "--" :long))
(short-options (build-options all-options "-" :short))
(options (nconc long-options short-options))
(words (append (text-utils:split-words (os-utils:getenv "COMP_WORDS"))
(list " ")))
(words-index (ignore-errors (parse-integer (os-utils:getenv "COMP_CWORD"))))
(command-line (os-utils:getenv "COMP_LINE")))
(declare (ignore command-line))
(when (and words
words-index)
(if (< words-index
(length words))
(cond
((complete-after-switch-p words
words-index
"-t"
"--timeline")
(complete-after-switch words
words-index
(db:default-timelines)))
((complete-after-switch-p words
words-index
"-f"
"--folder")
(complete-after-switch words
words-index
(db:all-folders)))
(t
(let ((matched (sort (remove-unmatched words
words-index
options)
(lambda (a b)
(< (length a)
(length b))))))
(if matched
(progn
(write-shell-array matched))
(write-shell-array options)))))
(write-shell-array options)))))))
(defun fediverse-account-parameters ()
(when-let ((split (cl-ppcre:split +fediverse-account-name-server-separator+

4
src/db.lisp
View File

@ -1092,7 +1092,7 @@ than (swconf:config-purge-history-days-offset) days in the past"
(query insert-query)))))
(defmethod update-db ((object tooter:poll) &key (status-id nil) &allow-other-keys)
(assert status-id)
(assert (string-not-empty-p status-id))
(with-accessors ((id tooter:id)
(expires-at tooter:expires-at)
(expired tooter:expired)
@ -1480,7 +1480,7 @@ than (swconf:config-purge-history-days-offset) days in the past"
(hooks:run-hook-compose 'hooks:*after-saving-message* db-status)))
;; add poll or update poll's votes
(when actual-poll
(if reblog-id
(if parent
(update-db actual-poll :status-id reblog-id)
(update-db actual-poll :status-id id))))))))

14
src/text-utils.lisp
View File

@ -270,20 +270,30 @@
(defun string-not-empty-p (s)
(not (string-empty-p s)))
(defun string-starts-with-p (start s &key (test #'string=))
(defgeneric string-starts-with-p (start s &key test))
(defmethod string-starts-with-p ((start string) s &key (test #'string=))
"Returns non nil if `s' starts with the substring `start'.
Uses `test' to match strings (default #'string=)"
(when (>= (length s)
(length start))
(funcall test s start :start1 0 :end1 (length start))))
(defun string-ends-with-p (end s &key (test #'string=))
(defmethod string-starts-with-p ((end character) s &key (test #'string=))
(string-starts-with-p (string end) s :test test))
(defgeneric string-ends-with-p (end s &key test))
(defmethod string-ends-with-p ((end string) s &key (test #'string=))
"Returns t if s ends with the substring 'end', nil otherwise.
Uses `test' to match strings (default #'string=)"
(when (>= (length s)
(length end))
(funcall test s end :start1 (- (length s) (length end)))))
(defmethod string-ends-with-p ((end character) s &key (test #'string=))
(string-ends-with-p (string end) s :test test))
(defun justify-monospaced-text (text &optional (chars-per-line 30))
(if (null (split-words text))
(list " ")