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

- 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 2020-06-11 17:28:39 +02:00
parent 0895409af5
commit 93950ca530
7 changed files with 252 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
etc/shared.conf
View File

@ -75,4 +75,10 @@ color-regexp = "/[^/]+/" #ffff00 italic
color-regexp = "⯀" green bold 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"

57
src/api-client.lisp
View File

@ -284,23 +284,29 @@ authorizations was performed with success."
(string< (tooter:id a) (string< (tooter:id a)
(tooter:id b))) (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 (loop for status in statuses do
(let ((add-fetched-event (make-instance 'program-events:add-pagination-status-event (let ((add-fetched-event (make-instance 'program-events:add-pagination-status-event
:priority event-priority
:status-id (tooter:id status) :status-id (tooter:id status)
:timeline timeline :timeline timeline
:folder folder))) :folder folder)))
(program-events:push-event add-fetched-event)))) (program-events:push-event add-fetched-event))))
(defun-w-lock update-timeline (timeline kind (defun-w-lock update-timeline (timeline
folder kind
&key folder
local &key
only-media recover-from-skipped-statuses
max-id local
since-id only-media
min-id max-id
(limit 20)) since-id
min-id
(recover-count 0)
(limit 20))
*client-lock* *client-lock*
"Update a timeline, this function will fetch new messages and generate and event to "Update a timeline, this function will fetch new messages and generate and event to
update the program reflectings the changes in the timeline (saves update the program reflectings the changes in the timeline (saves
@ -316,16 +322,25 @@ authorizations was performed with success."
(expand-status-tree node-status)))) (expand-status-tree node-status))))
(event (make-instance 'program-events:save-timeline-in-db-event (event (make-instance 'program-events:save-timeline-in-db-event
:payload trees :payload trees
:kind kind
:timeline-type timeline :timeline-type timeline
:folder folder :folder folder
:localp local :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 ;; 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 ;; later, the events generated by the function below will run
;; after the save-timeline-in-db-event; in this case it does not ;; after the save-timeline-in-db-event, that is because we give the
;; matter, though ;; event generated by 'update-pagination-statuses-so-far' the maximum priority
(update-pagination-statuses-so-far timeline-statuses timeline folder) (update-pagination-statuses-so-far timeline-statuses
timeline
folder
:event-priority
program-events:+maximum-event-priority+)
(program-events:push-event event))) (program-events:push-event event)))
(defun-w-lock get-timeline-tag (tag &key min-id (limit 20)) (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 :min-id min-id
:limit limit)) :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* *client-lock*
"Update a tag timeline, this function will fetch new messages (that "Update a tag timeline, this function will fetch new messages (that
contains tag `tag') and generate and event to update the program 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+ :timeline-type db:+federated-timeline+
:folder folder :folder folder
:localp nil :localp nil
:min-id min-id))) :min-id min-id
:recover-count recover-count)))
(update-pagination-statuses-so-far timeline-statuses (update-pagination-statuses-so-far timeline-statuses
db:+default-tag-timeline+ db:+default-tag-timeline+
folder) folder
:event-priority
program-events:+maximum-event-priority+)
(program-events:push-event save-timeline-in-db-event)))) (program-events:push-event save-timeline-in-db-event))))
(defun tag-name (tag &key (return-empty-string-if-nil nil)) (defun tag-name (tag &key (return-empty-string-if-nil nil))

60
src/db.lisp
View File

@ -95,6 +95,9 @@
(define-constant +table-ignored-status+ :ignored-status (define-constant +table-ignored-status+ :ignored-status
:test #'eq) :test #'eq)
(define-constant +table-skipped-status+ :skipped-status
:test #'eq)
(define-constant +table-pagination-status+ :pagination-status (define-constant +table-pagination-status+ :pagination-status
:test #'eq) :test #'eq)
@ -455,6 +458,15 @@
" \"created-at\" TEXT NOT NULL" " \"created-at\" TEXT NOT NULL"
+make-close+))) +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 () (defun make-pagination-status ()
(query-low-level (strcat (prepare-table +table-pagination-status+ :autoincrementp t) (query-low-level (strcat (prepare-table +table-pagination-status+ :autoincrementp t)
" \"status-id\" TEXT NOT NULL, " " \"status-id\" TEXT NOT NULL, "
@ -468,6 +480,7 @@
(create-table-index +table-followed-user+ '(:user-id)) (create-table-index +table-followed-user+ '(:user-id))
(create-table-index +table-subscribed-tag+ '(:id)) (create-table-index +table-subscribed-tag+ '(:id))
(create-table-index +table-ignored-status+ '(:folder :timeline :status-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-pagination-status+ '(:folder :timeline :status-id))
(create-table-index +table-conversation+ '(:id)) (create-table-index +table-conversation+ '(:id))
(create-table-index +table-cache+ '(:id :key))) (create-table-index +table-cache+ '(:id :key)))
@ -489,6 +502,8 @@
+table-attachment+ +table-attachment+
+table-conversation+ +table-conversation+
+table-pagination-status+ +table-pagination-status+
+table-ignored-status+
+table-skipped-status+
+table-poll-option+ +table-poll-option+
+table-poll+)) +table-poll+))
@ -511,6 +526,7 @@
(make-followed-user) (make-followed-user)
(make-status) (make-status)
(make-ignored-status) (make-ignored-status)
(make-skipped-status)
(make-attachment) (make-attachment)
(make-subscribed-tag) (make-subscribed-tag)
(make-tag-histogram) (make-tag-histogram)
@ -564,6 +580,24 @@
"Delete a row from a `table' by column named `:id' with value `id'" "Delete a row from a `table' by column named `:id' with value `id'"
(query (delete-from table (where (:= :id 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) (defun acct->user (acct)
"Convert `acct' (acct is synonyym for username in mastodon account) "Convert `acct' (acct is synonyym for username in mastodon account)
to the corresponding row in table +table-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) (:and (:= :day actual-day)
(:= :tag tag))))))))) (:= :tag tag)))))))))
(defun account-ignored-p (account-id)
(db-getf (fetch-from-id :account account-id)
:ignoredp nil))
(defmethod update-db ((object tooter:status) (defmethod update-db ((object tooter:status)
&key &key
(timeline +local-timeline+) (timeline +local-timeline+)
@ -1050,7 +1080,7 @@ than (swconf:config-purge-history-days-offset) days in the past"
(reblog-id (if parent (reblog-id (if parent
(prepare-for-db (tooter:id parent)) (prepare-for-db (tooter:id parent))
(prepare-for-db nil))) (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))) (status-ignored-p (status-ignored-p id folder timeline)))
(when (not (and skip-ignored-p (when (not (and skip-ignored-p
(or status-ignored-p (or status-ignored-p
@ -2093,6 +2123,16 @@ account that wrote the status identified by `status-id'"
(:= :folder folder) (:= :folder folder)
(:= :timeline timeline)))))) (:= :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) (defmacro with-db-current-timestamp ((timestamp) &body body)
`(let ((,timestamp (prepare-for-db (local-time-obj-now)))) `(let ((,timestamp (prepare-for-db (local-time-obj-now))))
,@body)) ,@body))
@ -2106,6 +2146,16 @@ account that wrote the status identified by `status-id'"
(:status-id :folder :timeline :created-at) (:status-id :folder :timeline :created-at)
(status-id folder timeline now)))))) (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) (defun add-to-followers (user-id)
(with-db-current-timestamp (now) (with-db-current-timestamp (now)
(query (make-insert +table-followed-user+ (query (make-insert +table-followed-user+

6
src/package.lisp
View File

@ -681,6 +681,8 @@
:fetch-from-id :fetch-from-id
:fetch-single :fetch-single
:delete-by-id :delete-by-id
:account-ignored-p
:user-ignored-p
:acct->user :acct->user
:acct->id :acct->id
:username->id :username->id
@ -783,7 +785,9 @@
:all-unfollowed-usernames :all-unfollowed-usernames
:all-ignored-usernames :all-ignored-usernames
:status-ignored-p :status-ignored-p
:status-skipped-p
:add-to-status-ignored :add-to-status-ignored
:add-to-status-skipped
:add-to-followers :add-to-followers
:remove-from-followers :remove-from-followers
:forget-all-statuses-marked-deleted :forget-all-statuses-marked-deleted
@ -936,6 +940,7 @@
:quote-char :quote-char
:max-attachments-allowed :max-attachments-allowed
:color-regexps :color-regexps
:ignore-users-regexps
:win-bg :win-bg
:win-fg :win-fg
:win-height :win-height
@ -1094,6 +1099,7 @@
(:export (:export
:+standard-event-priority+ :+standard-event-priority+
:+minimum-event-priority+ :+minimum-event-priority+
:+maximum-event-priority+
:*process-events-immediately* :*process-events-immediately*
:program-event :program-event
:event-id :event-id

115
src/program-events.lisp
View File

@ -31,6 +31,8 @@
(define-constant +minimum-event-priority+ -1 :test #'=) (define-constant +minimum-event-priority+ -1 :test #'=)
(define-constant +maximum-event-priority+ -2 :test #'=)
;; keep this function stricly monotonic otherwise the order of ;; keep this function stricly monotonic otherwise the order of
;; elements in priority queue is going to be messed up ;; elements in priority queue is going to be messed up
(defun-w-lock next-id () *id-lock* (defun-w-lock next-id () *id-lock*
@ -86,8 +88,14 @@
(if same-priority-p (if same-priority-p
(< (event-id a) (< (event-id a)
(event-id b)) (event-id b))
(< (priority a) (cond
(priority b))))) ((= (priority a) +maximum-event-priority+)
t)
((= (priority b) +maximum-event-priority+)
nil)
(t
(< (priority a)
(priority b)))))))
(defun queue-equals-predicate (a b) (defun queue-equals-predicate (a b)
(= (event-id a) (= (event-id a)
@ -259,43 +267,86 @@
(let ((win (payload object))) (let ((win (payload object)))
(mtree:remove-child specials:*main-window* win))) (mtree:remove-child specials:*main-window* win)))
(define-constant +max-recover-count+ 3)
(defclass save-timeline-in-db-event (program-event) (defclass save-timeline-in-db-event (program-event)
((timeline-type ((kind
:initform nil :initform nil
:initarg :timeline-type :initarg :kind
:accessor timeline-type) :accessor kind)
(timeline-type
:initform nil
:initarg :timeline-type
:accessor timeline-type)
(folder (folder
:initform nil :initform nil
:initarg :folder :initarg :folder
:accessor folder) :accessor folder)
(local (local
:initform nil :initform nil
:initarg :localp :initarg :localp
:reader localp :reader localp
:writer (setf local)) :writer (setf local))
(min-id (min-id
:initform nil :initform nil
:initarg :min-id :initarg :min-id
:accessor 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)) (defmethod process-event ((object save-timeline-in-db-event))
"Update a timeline, save messages, performs topological sorts" "Update a timeline, save messages, performs topological sorts"
(let ((statuses (payload object)) (let ((statuses (payload object))
(timeline-type (timeline-type object)) (ignored-count 0))
(folder (folder object))) (with-accessors ((timeline-type timeline-type)
#+debug-mode (folder folder)
(let ((dump (with-output-to-string (stream) (min-id min-id)
(mapcar (lambda (toot) (tooter::present toot stream)) (max-id max-id)
statuses)))) (kind kind)
(dbg "statuses ~a" dump)) (recover-count recover-count)) object
(loop for status in statuses do #+debug-mode
(db:update-db status (let ((dump (with-output-to-string (stream)
:timeline timeline-type (mapcar (lambda (toot) (tooter::present toot stream))
:folder folder statuses))))
:skip-ignored-p t)) (dbg "statuses ~a" dump))
(db:renumber-timeline-message-index timeline-type (loop for status in statuses do
folder (let ((account-id (tooter:id (tooter:account status)))
:account-id nil))) (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) ()) (defclass fetch-remote-status-event (program-event) ())

85
src/software-configuration.lisp
View File

@ -17,57 +17,60 @@
(in-package :software-configuration) (in-package :software-configuration)
;; CONFIG := (ENTRIES)* ;; CONFIG := (ENTRIES)*
;; ENTRIES := COMMENT* ;; ENTRIES := COMMENT*
;; (USE-FILE ;; (USE-FILE
;; | IGNORE-USER-RE-ASSIGN
;; | COLOR-RE-ASSIGN ;; | COLOR-RE-ASSIGN
;; | SERVER-ASSIGN ;; | SERVER-ASSIGN
;; | USERNAME-ASSIGN ;; | USERNAME-ASSIGN
;; | GENERIC-ASSIGN) ;; | GENERIC-ASSIGN)
;; COMMENT* ;; COMMENT*
;; SERVER-ASSIGN := SERVER-KEY BLANKS ASSIGN BLANKS GENERIC-VALUE BLANKS ;; SERVER-ASSIGN := SERVER-KEY BLANKS ASSIGN BLANKS GENERIC-VALUE BLANKS
;; USERNAME-ASSIGN := USERNAME-KEY BLANKS ASSIGN BLANKS GENERIC-VALUE BLANKS ;; USERNAME-ASSIGN := USERNAME-KEY BLANKS ASSIGN BLANKS GENERIC-VALUE BLANKS
;; GENERIC-ASSIGN := (and key blanks assign blanks ;; GENERIC-ASSIGN := (and key blanks assign blanks
;; (or quoted-string ;; (or quoted-string
;; hexcolor ;; hexcolor
;; colorname ;; colorname
;; generic-value) ; the order in this list *is* important ;; generic-value) ; the order in this list *is* important
;; blanks) ;; blanks)
;; COLOR-RE-ASSIGN := COLOR-RE-KEY ASSIGN REGEXP FG-COLOR (? ATTRIBUTE-VALUE) ;; IGNORE-USER-RE-ASSIGN := IGNORE-USER-RE-KEY ASSIGN REGEXP
;; USE-FILE := (AND USE BLANKS FILEPATH BLANKS) ;; COLOR-RE-ASSIGN := COLOR-RE-KEY ASSIGN REGEXP FG-COLOR (? ATTRIBUTE-VALUE)
;; KEY := FIELD (FIELD-SEPARATOR KEY)* ;; USE-FILE := (AND USE BLANKS FILEPATH BLANKS)
;; BLANKS := (BLANK)* ;; KEY := FIELD (FIELD-SEPARATOR KEY)*
;; FILEPATH := QUOTED-STRING ;; BLANKS := (BLANK)*
;; USE := "use" ;; FILEPATH := QUOTED-STRING
;; SERVER-KEY := "server" ;; USE := "use"
;; USERNAME-KEY := "username" ;; SERVER-KEY := "server"
;; COLOR-RE-KEY := "color-regexp" ;; USERNAME-KEY := "username"
;; REGEXP := QUOTED-STRING ;; COLOR-RE-KEY := "color-regexp"
;; QUOTED-STRING := #\" (not #\") #\" ;; IGNORE-USER-RE-KEY := "ignore-user-regexp"
;; FIELD := ( (or ESCAPED-CHARACTER ;; REGEXP := QUOTED-STRING
;; QUOTED-STRING := #\" (not #\") #\"
;; FIELD := ( (or ESCAPED-CHARACTER
;; (not #\# ASSIGN BLANK FIELD-SEPARATOR) )* ;; (not #\# ASSIGN BLANK FIELD-SEPARATOR) )*
;; COMMENT := BLANKS #\# (not #\Newline)* BLANKS ;; COMMENT := BLANKS #\# (not #\Newline)* BLANKS
;; FIELD-SEPARATOR := #\. ;; FIELD-SEPARATOR := #\.
;; GENERIC-VALUE := KEY ;; GENERIC-VALUE := KEY
;; ASSIGN := #\= ;; ASSIGN := #\=
;; BLANK := (or #\space #\Newline #\Tab) ;; BLANK := (or #\space #\Newline #\Tab)
;; BG-COLOR := COLOR ;; BG-COLOR := COLOR
;; FG-COLOR := COLOR ;; FG-COLOR := COLOR
;; COLOR := HEX-COLOR | COLOR-NAME ;; COLOR := HEX-COLOR | COLOR-NAME
;; HEX-COLOR := HEXCOLOR-PREFIX ;; HEX-COLOR := HEXCOLOR-PREFIX
;; HEXDIGIT HEXDIGIT -> red ;; HEXDIGIT HEXDIGIT -> red
;; HEXDIGIT HEXDIGIT -> green ;; HEXDIGIT HEXDIGIT -> green
;; HEXDIGIT HEXDIGIT -> blue ;; HEXDIGIT HEXDIGIT -> blue
;; ESCAPED-CHARACTER := #\\ any-character ;; ESCAPED-CHARACTER := #\\ any-character
;; HEXCOLOR-PREFIX := #\# ;; HEXCOLOR-PREFIX := #\#
;; HEX-DIGIT := (and (character-ranges #\0 #\9) ;; HEX-DIGIT := (and (character-ranges #\0 #\9)
;; (character-ranges #\a #\f) ;; (character-ranges #\a #\f)
;; (character-ranges #\A #\f) ;; (character-ranges #\A #\f)
;; ATTRIBUTE-VALUE := "bold" ;; ATTRIBUTE-VALUE := "bold"
;; | "italic" ;; | "italic"
;; | "underline" ;; | "underline"
;; | "blink" ;; | "blink"
;; COLOR-NAME := "black" ;; COLOR-NAME := "black"
;; | "red" ;; | "red"
;; | "green" ;; | "green"
;; | "yellow" ;; | "yellow"
@ -224,6 +227,7 @@
(and color-name-p color) (and color-name-p color)
(and (not color-name-p) color) (and (not color-name-p) color)
attributes)))) attributes))))
(defrule attribute-value (or "bold" (defrule attribute-value (or "bold"
"italic" "italic"
"underline" "underline"
@ -239,6 +243,14 @@
(:function remove-if-null) (:function remove-if-null)
(:function build-color-re-assign)) (: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" (defrule server-key "server"
(:constant :server)) (:constant :server))
@ -271,6 +283,7 @@
(and (* comment) (and (* comment)
(or use-file (or use-file
color-re-assign color-re-assign
ignore-user-re-assign
server-assign server-assign
username-assign username-assign
generic-assign) generic-assign)
@ -376,6 +389,7 @@
read read
unread unread
color-re color-re
ignore-user-re
purge-history-days-offset purge-history-days-offset
purge-cache-days-offset) purge-cache-days-offset)
@ -388,7 +402,8 @@
(let ((key (first entry)) (let ((key (first entry))
(value (second entry))) (value (second entry)))
(cond (cond
((eq +key-color-re+ key) ((or (eq +key-color-re+ key)
(eq +key-ignore-user-re+ key))
(setf (access:accesses *software-configuration* key) (setf (access:accesses *software-configuration* key)
(append (access:accesses *software-configuration* key) (append (access:accesses *software-configuration* key)
(list value)))) (list value))))
@ -520,6 +535,10 @@
(access:accesses *software-configuration* (access:accesses *software-configuration*
+key-color-re+)) +key-color-re+))
(defun ignore-users-regexps ()
(access:accesses *software-configuration*
+key-ignore-user-re+))
(defmacro gen-win-key-access (fn-suffix key) (defmacro gen-win-key-access (fn-suffix key)
`(defun ,(misc:format-fn-symbol t "win-~a" fn-suffix) (win-key) `(defun ,(misc:format-fn-symbol t "win-~a" fn-suffix) (win-key)
(access:accesses *software-configuration* (access:accesses *software-configuration*
@ -770,7 +789,7 @@
+key-value+)) +key-value+))
(defun date-fmt (window-key) (defun date-fmt (window-key)
(let* ((raw (access:accesses *software-configuration* (let* ((raw (access:accesses *software-configuration*
window-key window-key
+key-date-format+ +key-date-format+
+key-value+))) +key-value+)))

16
src/ui-goodies.lisp
View File

@ -501,7 +501,7 @@ and if fetch local (again, to server) statuses only."
((string= timeline db:+home-timeline+) ((string= timeline db:+home-timeline+)
(values :home nil)))) (values :home nil))))
(defun update-current-timeline () (defun update-current-timeline (&optional (recover-count 0))
"Update current timeline "Update current timeline
This command also checks notifications about mentioning the user This command also checks notifications about mentioning the user
@ -517,8 +517,10 @@ folder \"mentions\"."
(client:update-timeline timeline (client:update-timeline timeline
kind kind
folder folder
:min-id max-id :recover-from-skipped-statuses t
:local localp) :recover-count recover-count
:min-id max-id
:local localp)
(let ((update-mentions-event (make-instance 'update-mentions-event)) (let ((update-mentions-event (make-instance 'update-mentions-event))
(refresh-event (make-instance 'refresh-thread-windows-event))) (refresh-event (make-instance 'refresh-thread-windows-event)))
;; updating home also triggers the checks for mentions ;; updating home also triggers the checks for mentions
@ -530,7 +532,7 @@ folder \"mentions\"."
:ending-message (_ "Messages downloaded.") :ending-message (_ "Messages downloaded.")
:life-start (* (swconf:config-notification-life) 5)))))) :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 "Update current timeline backwards
Starting from the oldest toot and going back." Starting from the oldest toot and going back."
@ -544,8 +546,10 @@ Starting from the oldest toot and going back."
(client:update-timeline timeline (client:update-timeline timeline
kind kind
folder folder
:max-id min-id :recover-count recover-count
:local localp) :recover-from-skipped-statuses t
:max-id min-id
:local localp)
(let ((refresh-event (make-instance 'refresh-thread-windows-event))) (let ((refresh-event (make-instance 'refresh-thread-windows-event)))
(push-event refresh-event))))) (push-event refresh-event)))))
(notify-procedure #'update (notify-procedure #'update