mirror of https://codeberg.org/cage/tinmop/
- fixed skipping of ignored users
When a set of downloaded statuses contains one or more status from an ignored user restarts the download process again starting from the last (or first, if going backward) downloaded status (ordered by ID). This way we could skip over a bunch of ignored status. The number of download restarting iteration is limited to 3 - added a configuration directive to ignore usernames that match a regular exception.
This commit is contained in:
cage
parent
0895409af5
commit
93950ca530
|
|
@ -75,4 +75,10 @@ color-regexp = "/[^/]+/" #ffff00 italic
|
|||
|
||||
color-regexp = "⯀" green bold
|
||||
|
||||
color-regexp = "The poll has expired" #ff00ff bold
|
||||
color-regexp = "The poll has expired" #ff00ff bold
|
||||
|
||||
# you can filter off users using regexp
|
||||
|
||||
# ignore-user-regexp = "@domain-name$"
|
||||
|
||||
# ignore-user-regexp = "^user-name@domain-name"
|
||||
|
|
@ -284,23 +284,29 @@ authorizations was performed with success."
|
|||
(string< (tooter:id a)
|
||||
(tooter:id b)))
|
||||
|
||||
(defun update-pagination-statuses-so-far (statuses timeline folder)
|
||||
(defun update-pagination-statuses-so-far (statuses timeline folder
|
||||
&key
|
||||
(event-priority program-events:+standard-event-priority+))
|
||||
(loop for status in statuses do
|
||||
(let ((add-fetched-event (make-instance 'program-events:add-pagination-status-event
|
||||
:priority event-priority
|
||||
:status-id (tooter:id status)
|
||||
:timeline timeline
|
||||
:folder folder)))
|
||||
(program-events:push-event add-fetched-event))))
|
||||
|
||||
(defun-w-lock update-timeline (timeline kind
|
||||
folder
|
||||
&key
|
||||
local
|
||||
only-media
|
||||
max-id
|
||||
since-id
|
||||
min-id
|
||||
(limit 20))
|
||||
(defun-w-lock update-timeline (timeline
|
||||
kind
|
||||
folder
|
||||
&key
|
||||
recover-from-skipped-statuses
|
||||
local
|
||||
only-media
|
||||
max-id
|
||||
since-id
|
||||
min-id
|
||||
(recover-count 0)
|
||||
(limit 20))
|
||||
*client-lock*
|
||||
"Update a timeline, this function will fetch new messages and generate and event to
|
||||
update the program reflectings the changes in the timeline (saves
|
||||
|
|
@ -316,16 +322,25 @@ authorizations was performed with success."
|
|||
(expand-status-tree node-status))))
|
||||
(event (make-instance 'program-events:save-timeline-in-db-event
|
||||
:payload trees
|
||||
:kind kind
|
||||
:timeline-type timeline
|
||||
:folder folder
|
||||
:localp local
|
||||
:min-id min-id)))
|
||||
:min-id min-id
|
||||
:max-id max-id
|
||||
:recover-count recover-count
|
||||
:recover-from-skipped-statuses
|
||||
recover-from-skipped-statuses)))
|
||||
;; note that, because events are enqueued with priority and the
|
||||
;; first instanced event has better priority the another instanced
|
||||
;; first instanced event has better priority than another instanced
|
||||
;; later, the events generated by the function below will run
|
||||
;; after the save-timeline-in-db-event; in this case it does not
|
||||
;; matter, though
|
||||
(update-pagination-statuses-so-far timeline-statuses timeline folder)
|
||||
;; after the save-timeline-in-db-event, that is because we give the
|
||||
;; event generated by 'update-pagination-statuses-so-far' the maximum priority
|
||||
(update-pagination-statuses-so-far timeline-statuses
|
||||
timeline
|
||||
folder
|
||||
:event-priority
|
||||
program-events:+maximum-event-priority+)
|
||||
(program-events:push-event event)))
|
||||
|
||||
(defun-w-lock get-timeline-tag (tag &key min-id (limit 20))
|
||||
|
|
@ -340,7 +355,10 @@ authorizations was performed with success."
|
|||
:min-id min-id
|
||||
:limit limit))
|
||||
|
||||
(defun-w-lock update-timeline-tag (tag folder &key min-id (limit 20))
|
||||
(defun-w-lock update-timeline-tag (tag folder &key
|
||||
(recover-count 0)
|
||||
min-id
|
||||
(limit 20))
|
||||
*client-lock*
|
||||
"Update a tag timeline, this function will fetch new messages (that
|
||||
contains tag `tag') and generate and event to update the program
|
||||
|
|
@ -357,10 +375,13 @@ authorizations was performed with success."
|
|||
:timeline-type db:+federated-timeline+
|
||||
:folder folder
|
||||
:localp nil
|
||||
:min-id min-id)))
|
||||
:min-id min-id
|
||||
:recover-count recover-count)))
|
||||
(update-pagination-statuses-so-far timeline-statuses
|
||||
db:+default-tag-timeline+
|
||||
folder)
|
||||
folder
|
||||
:event-priority
|
||||
program-events:+maximum-event-priority+)
|
||||
(program-events:push-event save-timeline-in-db-event))))
|
||||
|
||||
(defun tag-name (tag &key (return-empty-string-if-nil nil))
|
||||
|
|
|
|||
60
src/db.lisp
60
src/db.lisp
|
|
@ -95,6 +95,9 @@
|
|||
(define-constant +table-ignored-status+ :ignored-status
|
||||
:test #'eq)
|
||||
|
||||
(define-constant +table-skipped-status+ :skipped-status
|
||||
:test #'eq)
|
||||
|
||||
(define-constant +table-pagination-status+ :pagination-status
|
||||
:test #'eq)
|
||||
|
||||
|
|
@ -455,6 +458,15 @@
|
|||
" \"created-at\" TEXT NOT NULL"
|
||||
+make-close+)))
|
||||
|
||||
(defun make-skipped-status ()
|
||||
(query-low-level (strcat (prepare-table +table-skipped-status+ :autoincrementp t)
|
||||
" \"status-id\" TEXT NOT NULL, "
|
||||
" timeline TEXT NOT NULL, "
|
||||
" folder TEXT NOT NULL, "
|
||||
;; timestamp
|
||||
" \"created-at\" TEXT NOT NULL"
|
||||
+make-close+)))
|
||||
|
||||
(defun make-pagination-status ()
|
||||
(query-low-level (strcat (prepare-table +table-pagination-status+ :autoincrementp t)
|
||||
" \"status-id\" TEXT NOT NULL, "
|
||||
|
|
@ -468,6 +480,7 @@
|
|||
(create-table-index +table-followed-user+ '(:user-id))
|
||||
(create-table-index +table-subscribed-tag+ '(:id))
|
||||
(create-table-index +table-ignored-status+ '(:folder :timeline :status-id))
|
||||
(create-table-index +table-skipped-status+ '(:folder :timeline :status-id))
|
||||
(create-table-index +table-pagination-status+ '(:folder :timeline :status-id))
|
||||
(create-table-index +table-conversation+ '(:id))
|
||||
(create-table-index +table-cache+ '(:id :key)))
|
||||
|
|
@ -489,6 +502,8 @@
|
|||
+table-attachment+
|
||||
+table-conversation+
|
||||
+table-pagination-status+
|
||||
+table-ignored-status+
|
||||
+table-skipped-status+
|
||||
+table-poll-option+
|
||||
+table-poll+))
|
||||
|
||||
|
|
@ -511,6 +526,7 @@
|
|||
(make-followed-user)
|
||||
(make-status)
|
||||
(make-ignored-status)
|
||||
(make-skipped-status)
|
||||
(make-attachment)
|
||||
(make-subscribed-tag)
|
||||
(make-tag-histogram)
|
||||
|
|
@ -564,6 +580,24 @@
|
|||
"Delete a row from a `table' by column named `:id' with value `id'"
|
||||
(query (delete-from table (where (:= :id id)))))
|
||||
|
||||
(defun account-ignored-p (account-id)
|
||||
"Returns non nil if this account has been setted as ignored by the user"
|
||||
(let* ((db-account-row (fetch-from-id :account account-id))
|
||||
(account-known-p db-account-row))
|
||||
(and account-known-p
|
||||
(db-getf db-account-row
|
||||
:ignoredp nil))))
|
||||
|
||||
(defun user-ignored-p (account-id)
|
||||
"Returns non nil if this account must be ignored"
|
||||
(or (db:account-ignored-p account-id)
|
||||
(when-let ((ignore-regexps (swconf:ignore-users-regexps))
|
||||
(username (db:user-id->username account-id)))
|
||||
(loop for ignore-re in ignore-regexps do
|
||||
(when (cl-ppcre:scan ignore-re username)
|
||||
(return-from user-ignored-p t)))
|
||||
nil)))
|
||||
|
||||
(defun acct->user (acct)
|
||||
"Convert `acct' (acct is synonyym for username in mastodon account)
|
||||
to the corresponding row in table +table-account+"
|
||||
|
|
@ -995,10 +1029,6 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
|||
(:and (:= :day actual-day)
|
||||
(:= :tag tag)))))))))
|
||||
|
||||
(defun account-ignored-p (account-id)
|
||||
(db-getf (fetch-from-id :account account-id)
|
||||
:ignoredp nil))
|
||||
|
||||
(defmethod update-db ((object tooter:status)
|
||||
&key
|
||||
(timeline +local-timeline+)
|
||||
|
|
@ -1050,7 +1080,7 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
|||
(reblog-id (if parent
|
||||
(prepare-for-db (tooter:id parent))
|
||||
(prepare-for-db nil)))
|
||||
(account-ignored-p (account-ignored-p account-id))
|
||||
(account-ignored-p (user-ignored-p account-id))
|
||||
(status-ignored-p (status-ignored-p id folder timeline)))
|
||||
(when (not (and skip-ignored-p
|
||||
(or status-ignored-p
|
||||
|
|
@ -2093,6 +2123,16 @@ account that wrote the status identified by `status-id'"
|
|||
(:= :folder folder)
|
||||
(:= :timeline timeline))))))
|
||||
|
||||
(defun status-skipped-p (status-id folder timeline)
|
||||
"Return non nil if this status should be skipped because belong to an ignored account
|
||||
(id timeline and folder is the tuple that is primary key for table
|
||||
:status)"
|
||||
(query (select :*
|
||||
(from +table-skipped-status+)
|
||||
(where (:and (:= :status-id status-id)
|
||||
(:= :folder folder)
|
||||
(:= :timeline timeline))))))
|
||||
|
||||
(defmacro with-db-current-timestamp ((timestamp) &body body)
|
||||
`(let ((,timestamp (prepare-for-db (local-time-obj-now))))
|
||||
,@body))
|
||||
|
|
@ -2106,6 +2146,16 @@ account that wrote the status identified by `status-id'"
|
|||
(:status-id :folder :timeline :created-at)
|
||||
(status-id folder timeline now))))))
|
||||
|
||||
(defun add-to-status-skipped (status-id folder timeline)
|
||||
"Skips this status (id timeline and folder is the tuple that is
|
||||
primary key for table :status), if in this table the
|
||||
status has been downloaded from the net and ignored because belog to an ignored account."
|
||||
(when (not (status-skipped-p status-id folder timeline))
|
||||
(with-db-current-timestamp (now)
|
||||
(query (make-insert +table-skipped-status+
|
||||
(:status-id :folder :timeline :created-at)
|
||||
(status-id folder timeline now))))))
|
||||
|
||||
(defun add-to-followers (user-id)
|
||||
(with-db-current-timestamp (now)
|
||||
(query (make-insert +table-followed-user+
|
||||
|
|
|
|||
|
|
@ -681,6 +681,8 @@
|
|||
:fetch-from-id
|
||||
:fetch-single
|
||||
:delete-by-id
|
||||
:account-ignored-p
|
||||
:user-ignored-p
|
||||
:acct->user
|
||||
:acct->id
|
||||
:username->id
|
||||
|
|
@ -783,7 +785,9 @@
|
|||
:all-unfollowed-usernames
|
||||
:all-ignored-usernames
|
||||
:status-ignored-p
|
||||
:status-skipped-p
|
||||
:add-to-status-ignored
|
||||
:add-to-status-skipped
|
||||
:add-to-followers
|
||||
:remove-from-followers
|
||||
:forget-all-statuses-marked-deleted
|
||||
|
|
@ -936,6 +940,7 @@
|
|||
:quote-char
|
||||
:max-attachments-allowed
|
||||
:color-regexps
|
||||
:ignore-users-regexps
|
||||
:win-bg
|
||||
:win-fg
|
||||
:win-height
|
||||
|
|
@ -1094,6 +1099,7 @@
|
|||
(:export
|
||||
:+standard-event-priority+
|
||||
:+minimum-event-priority+
|
||||
:+maximum-event-priority+
|
||||
:*process-events-immediately*
|
||||
:program-event
|
||||
:event-id
|
||||
|
|
|
|||
|
|
@ -31,6 +31,8 @@
|
|||
|
||||
(define-constant +minimum-event-priority+ -1 :test #'=)
|
||||
|
||||
(define-constant +maximum-event-priority+ -2 :test #'=)
|
||||
|
||||
;; keep this function stricly monotonic otherwise the order of
|
||||
;; elements in priority queue is going to be messed up
|
||||
(defun-w-lock next-id () *id-lock*
|
||||
|
|
@ -86,8 +88,14 @@
|
|||
(if same-priority-p
|
||||
(< (event-id a)
|
||||
(event-id b))
|
||||
(< (priority a)
|
||||
(priority b)))))
|
||||
(cond
|
||||
((= (priority a) +maximum-event-priority+)
|
||||
t)
|
||||
((= (priority b) +maximum-event-priority+)
|
||||
nil)
|
||||
(t
|
||||
(< (priority a)
|
||||
(priority b)))))))
|
||||
|
||||
(defun queue-equals-predicate (a b)
|
||||
(= (event-id a)
|
||||
|
|
@ -259,43 +267,86 @@
|
|||
(let ((win (payload object)))
|
||||
(mtree:remove-child specials:*main-window* win)))
|
||||
|
||||
(define-constant +max-recover-count+ 3)
|
||||
|
||||
(defclass save-timeline-in-db-event (program-event)
|
||||
((timeline-type
|
||||
:initform nil
|
||||
:initarg :timeline-type
|
||||
:accessor timeline-type)
|
||||
((kind
|
||||
:initform nil
|
||||
:initarg :kind
|
||||
:accessor kind)
|
||||
(timeline-type
|
||||
:initform nil
|
||||
:initarg :timeline-type
|
||||
:accessor timeline-type)
|
||||
(folder
|
||||
:initform nil
|
||||
:initarg :folder
|
||||
:accessor folder)
|
||||
:initform nil
|
||||
:initarg :folder
|
||||
:accessor folder)
|
||||
(local
|
||||
:initform nil
|
||||
:initarg :localp
|
||||
:reader localp
|
||||
:writer (setf local))
|
||||
:initform nil
|
||||
:initarg :localp
|
||||
:reader localp
|
||||
:writer (setf local))
|
||||
(min-id
|
||||
:initform nil
|
||||
:initarg :min-id
|
||||
:accessor min-id)))
|
||||
:initform nil
|
||||
:initarg :min-id
|
||||
:accessor min-id)
|
||||
(max-id
|
||||
:initform nil
|
||||
:initarg :max-id
|
||||
:accessor max-id)
|
||||
(recover-from-skipped-statuses
|
||||
:initform nil
|
||||
:initarg :recover-from-skipped-statuses
|
||||
:reader recover-from-skipped-statuses-p
|
||||
:writer recover-from-skipped-statuses)
|
||||
(recover-count
|
||||
:initform 0
|
||||
:initarg :recover-count
|
||||
:accessor recover-count)))
|
||||
|
||||
(defmethod process-event ((object save-timeline-in-db-event))
|
||||
"Update a timeline, save messages, performs topological sorts"
|
||||
(let ((statuses (payload object))
|
||||
(timeline-type (timeline-type object))
|
||||
(folder (folder object)))
|
||||
#+debug-mode
|
||||
(let ((dump (with-output-to-string (stream)
|
||||
(mapcar (lambda (toot) (tooter::present toot stream))
|
||||
statuses))))
|
||||
(dbg "statuses ~a" dump))
|
||||
(loop for status in statuses do
|
||||
(db:update-db status
|
||||
:timeline timeline-type
|
||||
:folder folder
|
||||
:skip-ignored-p t))
|
||||
(db:renumber-timeline-message-index timeline-type
|
||||
folder
|
||||
:account-id nil)))
|
||||
(let ((statuses (payload object))
|
||||
(ignored-count 0))
|
||||
(with-accessors ((timeline-type timeline-type)
|
||||
(folder folder)
|
||||
(min-id min-id)
|
||||
(max-id max-id)
|
||||
(kind kind)
|
||||
(recover-count recover-count)) object
|
||||
#+debug-mode
|
||||
(let ((dump (with-output-to-string (stream)
|
||||
(mapcar (lambda (toot) (tooter::present toot stream))
|
||||
statuses))))
|
||||
(dbg "statuses ~a" dump))
|
||||
(loop for status in statuses do
|
||||
(let ((account-id (tooter:id (tooter:account status)))
|
||||
(status-id (tooter:id status)))
|
||||
(when (and (db:user-ignored-p account-id)
|
||||
(not (db:status-skipped-p status-id folder timeline-type)))
|
||||
(db:add-to-status-skipped status-id folder timeline-type)
|
||||
(incf ignored-count)))
|
||||
(db:update-db status
|
||||
:timeline timeline-type
|
||||
:folder folder
|
||||
:skip-ignored-p t))
|
||||
(db:renumber-timeline-message-index timeline-type
|
||||
folder
|
||||
:account-id nil)
|
||||
(when (and recover-count
|
||||
(< recover-count +max-recover-count+)
|
||||
(> ignored-count 0)
|
||||
(recover-from-skipped-statuses-p object))
|
||||
(let ((going-backward max-id)
|
||||
(going-forward (or (and (null max-id)
|
||||
(null min-id))
|
||||
min-id)))
|
||||
(cond
|
||||
(going-forward
|
||||
(ui:update-current-timeline (1+ recover-count)))
|
||||
(going-backward
|
||||
(ui:update-current-timeline-backwards (1+ recover-count)))))))))
|
||||
|
||||
(defclass fetch-remote-status-event (program-event) ())
|
||||
|
||||
|
|
|
|||
|
|
@ -17,57 +17,60 @@
|
|||
|
||||
(in-package :software-configuration)
|
||||
|
||||
;; CONFIG := (ENTRIES)*
|
||||
;; ENTRIES := COMMENT*
|
||||
;; CONFIG := (ENTRIES)*
|
||||
;; ENTRIES := COMMENT*
|
||||
;; (USE-FILE
|
||||
;; | IGNORE-USER-RE-ASSIGN
|
||||
;; | COLOR-RE-ASSIGN
|
||||
;; | SERVER-ASSIGN
|
||||
;; | USERNAME-ASSIGN
|
||||
;; | GENERIC-ASSIGN)
|
||||
;; COMMENT*
|
||||
;; SERVER-ASSIGN := SERVER-KEY BLANKS ASSIGN BLANKS GENERIC-VALUE BLANKS
|
||||
;; USERNAME-ASSIGN := USERNAME-KEY BLANKS ASSIGN BLANKS GENERIC-VALUE BLANKS
|
||||
;; GENERIC-ASSIGN := (and key blanks assign blanks
|
||||
;; SERVER-ASSIGN := SERVER-KEY BLANKS ASSIGN BLANKS GENERIC-VALUE BLANKS
|
||||
;; USERNAME-ASSIGN := USERNAME-KEY BLANKS ASSIGN BLANKS GENERIC-VALUE BLANKS
|
||||
;; GENERIC-ASSIGN := (and key blanks assign blanks
|
||||
;; (or quoted-string
|
||||
;; hexcolor
|
||||
;; colorname
|
||||
;; generic-value) ; the order in this list *is* important
|
||||
;; blanks)
|
||||
;; COLOR-RE-ASSIGN := COLOR-RE-KEY ASSIGN REGEXP FG-COLOR (? ATTRIBUTE-VALUE)
|
||||
;; USE-FILE := (AND USE BLANKS FILEPATH BLANKS)
|
||||
;; KEY := FIELD (FIELD-SEPARATOR KEY)*
|
||||
;; BLANKS := (BLANK)*
|
||||
;; FILEPATH := QUOTED-STRING
|
||||
;; USE := "use"
|
||||
;; SERVER-KEY := "server"
|
||||
;; USERNAME-KEY := "username"
|
||||
;; COLOR-RE-KEY := "color-regexp"
|
||||
;; REGEXP := QUOTED-STRING
|
||||
;; QUOTED-STRING := #\" (not #\") #\"
|
||||
;; FIELD := ( (or ESCAPED-CHARACTER
|
||||
;; IGNORE-USER-RE-ASSIGN := IGNORE-USER-RE-KEY ASSIGN REGEXP
|
||||
;; COLOR-RE-ASSIGN := COLOR-RE-KEY ASSIGN REGEXP FG-COLOR (? ATTRIBUTE-VALUE)
|
||||
;; USE-FILE := (AND USE BLANKS FILEPATH BLANKS)
|
||||
;; KEY := FIELD (FIELD-SEPARATOR KEY)*
|
||||
;; BLANKS := (BLANK)*
|
||||
;; FILEPATH := QUOTED-STRING
|
||||
;; USE := "use"
|
||||
;; SERVER-KEY := "server"
|
||||
;; USERNAME-KEY := "username"
|
||||
;; COLOR-RE-KEY := "color-regexp"
|
||||
;; IGNORE-USER-RE-KEY := "ignore-user-regexp"
|
||||
;; REGEXP := QUOTED-STRING
|
||||
;; QUOTED-STRING := #\" (not #\") #\"
|
||||
;; FIELD := ( (or ESCAPED-CHARACTER
|
||||
;; (not #\# ASSIGN BLANK FIELD-SEPARATOR) )*
|
||||
;; COMMENT := BLANKS #\# (not #\Newline)* BLANKS
|
||||
;; FIELD-SEPARATOR := #\.
|
||||
;; GENERIC-VALUE := KEY
|
||||
;; ASSIGN := #\=
|
||||
;; BLANK := (or #\space #\Newline #\Tab)
|
||||
;; BG-COLOR := COLOR
|
||||
;; FG-COLOR := COLOR
|
||||
;; COLOR := HEX-COLOR | COLOR-NAME
|
||||
;; HEX-COLOR := HEXCOLOR-PREFIX
|
||||
;; COMMENT := BLANKS #\# (not #\Newline)* BLANKS
|
||||
;; FIELD-SEPARATOR := #\.
|
||||
;; GENERIC-VALUE := KEY
|
||||
;; ASSIGN := #\=
|
||||
;; BLANK := (or #\space #\Newline #\Tab)
|
||||
;; BG-COLOR := COLOR
|
||||
;; FG-COLOR := COLOR
|
||||
;; COLOR := HEX-COLOR | COLOR-NAME
|
||||
;; HEX-COLOR := HEXCOLOR-PREFIX
|
||||
;; HEXDIGIT HEXDIGIT -> red
|
||||
;; HEXDIGIT HEXDIGIT -> green
|
||||
;; HEXDIGIT HEXDIGIT -> blue
|
||||
;; ESCAPED-CHARACTER := #\\ any-character
|
||||
;; HEXCOLOR-PREFIX := #\#
|
||||
;; HEX-DIGIT := (and (character-ranges #\0 #\9)
|
||||
;; ESCAPED-CHARACTER := #\\ any-character
|
||||
;; HEXCOLOR-PREFIX := #\#
|
||||
;; HEX-DIGIT := (and (character-ranges #\0 #\9)
|
||||
;; (character-ranges #\a #\f)
|
||||
;; (character-ranges #\A #\f)
|
||||
;; ATTRIBUTE-VALUE := "bold"
|
||||
;; ATTRIBUTE-VALUE := "bold"
|
||||
;; | "italic"
|
||||
;; | "underline"
|
||||
;; | "blink"
|
||||
;; COLOR-NAME := "black"
|
||||
;; COLOR-NAME := "black"
|
||||
;; | "red"
|
||||
;; | "green"
|
||||
;; | "yellow"
|
||||
|
|
@ -224,6 +227,7 @@
|
|||
(and color-name-p color)
|
||||
(and (not color-name-p) color)
|
||||
attributes))))
|
||||
|
||||
(defrule attribute-value (or "bold"
|
||||
"italic"
|
||||
"underline"
|
||||
|
|
@ -239,6 +243,14 @@
|
|||
(:function remove-if-null)
|
||||
(:function build-color-re-assign))
|
||||
|
||||
(defrule ignore-user-re-key "ignore-user-regexp"
|
||||
(:constant :ignore-user-re))
|
||||
|
||||
(defrule ignore-user-re-assign
|
||||
(and ignore-user-re-key blanks
|
||||
assign blanks regexp blanks)
|
||||
(:function (lambda (a) (list (first a) (fifth a)))))
|
||||
|
||||
(defrule server-key "server"
|
||||
(:constant :server))
|
||||
|
||||
|
|
@ -271,6 +283,7 @@
|
|||
(and (* comment)
|
||||
(or use-file
|
||||
color-re-assign
|
||||
ignore-user-re-assign
|
||||
server-assign
|
||||
username-assign
|
||||
generic-assign)
|
||||
|
|
@ -376,6 +389,7 @@
|
|||
read
|
||||
unread
|
||||
color-re
|
||||
ignore-user-re
|
||||
purge-history-days-offset
|
||||
purge-cache-days-offset)
|
||||
|
||||
|
|
@ -388,7 +402,8 @@
|
|||
(let ((key (first entry))
|
||||
(value (second entry)))
|
||||
(cond
|
||||
((eq +key-color-re+ key)
|
||||
((or (eq +key-color-re+ key)
|
||||
(eq +key-ignore-user-re+ key))
|
||||
(setf (access:accesses *software-configuration* key)
|
||||
(append (access:accesses *software-configuration* key)
|
||||
(list value))))
|
||||
|
|
@ -520,6 +535,10 @@
|
|||
(access:accesses *software-configuration*
|
||||
+key-color-re+))
|
||||
|
||||
(defun ignore-users-regexps ()
|
||||
(access:accesses *software-configuration*
|
||||
+key-ignore-user-re+))
|
||||
|
||||
(defmacro gen-win-key-access (fn-suffix key)
|
||||
`(defun ,(misc:format-fn-symbol t "win-~a" fn-suffix) (win-key)
|
||||
(access:accesses *software-configuration*
|
||||
|
|
@ -770,7 +789,7 @@
|
|||
+key-value+))
|
||||
|
||||
(defun date-fmt (window-key)
|
||||
(let* ((raw (access:accesses *software-configuration*
|
||||
(let* ((raw (access:accesses *software-configuration*
|
||||
window-key
|
||||
+key-date-format+
|
||||
+key-value+)))
|
||||
|
|
|
|||
|
|
@ -501,7 +501,7 @@ and if fetch local (again, to server) statuses only."
|
|||
((string= timeline db:+home-timeline+)
|
||||
(values :home nil))))
|
||||
|
||||
(defun update-current-timeline ()
|
||||
(defun update-current-timeline (&optional (recover-count 0))
|
||||
"Update current timeline
|
||||
|
||||
This command also checks notifications about mentioning the user
|
||||
|
|
@ -517,8 +517,10 @@ folder \"mentions\"."
|
|||
(client:update-timeline timeline
|
||||
kind
|
||||
folder
|
||||
:min-id max-id
|
||||
:local localp)
|
||||
:recover-from-skipped-statuses t
|
||||
:recover-count recover-count
|
||||
:min-id max-id
|
||||
:local localp)
|
||||
(let ((update-mentions-event (make-instance 'update-mentions-event))
|
||||
(refresh-event (make-instance 'refresh-thread-windows-event)))
|
||||
;; updating home also triggers the checks for mentions
|
||||
|
|
@ -530,7 +532,7 @@ folder \"mentions\"."
|
|||
:ending-message (_ "Messages downloaded.")
|
||||
:life-start (* (swconf:config-notification-life) 5))))))
|
||||
|
||||
(defun update-current-timeline-backwards ()
|
||||
(defun update-current-timeline-backwards (&optional (recover-count 0))
|
||||
"Update current timeline backwards
|
||||
|
||||
Starting from the oldest toot and going back."
|
||||
|
|
@ -544,8 +546,10 @@ Starting from the oldest toot and going back."
|
|||
(client:update-timeline timeline
|
||||
kind
|
||||
folder
|
||||
:max-id min-id
|
||||
:local localp)
|
||||
:recover-count recover-count
|
||||
:recover-from-skipped-statuses t
|
||||
:max-id min-id
|
||||
:local localp)
|
||||
(let ((refresh-event (make-instance 'refresh-thread-windows-event)))
|
||||
(push-event refresh-event)))))
|
||||
(notify-procedure #'update
|
||||
|
|
|
|||
Loading…
Reference in New Issue