fix calfw sort: wrapper sortuje periods list (org-caldav active-range → periods, sorter se nevztahoval)

This commit is contained in:
2026-02-24 23:46:16 +01:00
parent 6f9a72f1fc
commit cf4b4862cf

View File

@@ -1958,29 +1958,54 @@ current frame."
"<" #'calfw-navi-prev-view "<" #'calfw-navi-prev-view
">" #'calfw-navi-next-view) ">" #'calfw-navi-next-view)
;; Universal sorter pro cross-source (agenda + file-source): ;; org-caldav vytváří <date>--<date> pro same-day events → org-element type 'active-range
;; - file-source: cfw:event struct má :start-time (H M) — to je autoritativní ;; → calfw-org-convert-org-to-calfw dá tyto eventy do PERIODS (ne contents)
;; - agenda source: time-of-day property (HHMM integer) ;; → sorter se na periods nevztahuje → špatné pořadí
;; - month view formát je "%t" bez času, takže string parsing nefunguje ;; Fix: wrapper který sortuje periods list přímo před předáním calfw
(defun my/calfw-event-time-int (evt)
"Vrátí start-time jako HHMM integer, nebo nil."
(when-let ((st (calfw-event-start-time evt)))
(+ (* 100 (car st)) (cadr st))))
(defun my/calfw-sort-periods (result)
"Sortuje periods sublist v RESULT dle start-time."
(mapcar (lambda (item)
(if (and (listp item) (eq 'periods (car item)))
(cons 'periods
(sort (copy-sequence (cdr item))
(lambda (a b)
(let ((ta (my/calfw-event-time-int a))
(tb (my/calfw-event-time-int b)))
(cond ((and ta tb) (< ta tb))
(ta t)
(t nil))))))
item))
result))
(defun my/calfw-sorted-file-source (name file color)
"calfw-org-create-file-source s sortovanými periods."
(let ((base (calfw-org-create-file-source name file color)))
(make-calfw-source
:name (calfw-source-name base)
:color (calfw-source-color base)
:data (lambda (begin end)
(my/calfw-sort-periods
(funcall (calfw-source-data base) begin end))))))
;; Sorter pro contents (agenda events + file-source contents bez time-range)
(defun my/calfw-sorter (x y) (defun my/calfw-sorter (x y)
(let* ((ex (get-text-property 0 'cfw:event x)) (let* ((ex (get-text-property 0 'cfw:event x))
(ey (get-text-property 0 'cfw:event y)) (ey (get-text-property 0 'cfw:event y))
(tx (or (and ex (calfw-event-start-time ex)) ; file-source: (H M) (ta (or (and ex (my/calfw-event-time-int ex))
(let ((v (get-text-property 0 'time-of-day x))) ; agenda: HHMM int (get-text-property 0 'time-of-day x)))
(and v (list (/ v 100) (% v 100)))))) (tb (or (and ey (my/calfw-event-time-int ey))
(ty (or (and ey (calfw-event-start-time ey)) (get-text-property 0 'time-of-day y))))
(let ((v (get-text-property 0 'time-of-day y))) (cond ((and ta tb) (< ta tb)) (ta t) (tb nil) (t (string-lessp x y)))))
(and v (list (/ v 100) (% v 100))))))
(ta (and tx (+ (* 100 (car tx)) (cadr tx)))) ; → HHMM int
(tb (and ty (+ (* 100 (car ty)) (cadr ty)))))
(cond ((and ta tb) (< ta tb))
(ta t)
(tb nil)
(t (string-lessp x y)))))
(defun my/open-calendar () (defun my/open-calendar ()
"Calfw: org-agenda (SeaGreen) + CalDAV soubory (Suky=modrá, Klára=žlutá, Rodina=zelená). "Calfw: org-agenda + CalDAV (Suky=modrá, Klára=žlutá, Rodina=zelená).
org-caldav ukládá plain active timestamps → calfw-org-create-file-source je správná volba." org-caldav ukládá same-day events jako active-range → periods → wrapper je sortuje."
(interactive) (interactive)
(condition-case err (condition-case err
(let* ((cd (expand-file-name "~/org/caldav/")) (let* ((cd (expand-file-name "~/org/caldav/"))
@@ -1988,11 +2013,11 @@ org-caldav ukládá plain active timestamps → calfw-org-create-file-source je
(list (list
(calfw-org-create-source nil "Agenda" "SeaGreen4") (calfw-org-create-source nil "Agenda" "SeaGreen4")
(when (file-exists-p (concat cd "suky.org")) (when (file-exists-p (concat cd "suky.org"))
(calfw-org-create-file-source "Suky" (concat cd "suky.org") "SteelBlue")) (my/calfw-sorted-file-source "Suky" (concat cd "suky.org") "SteelBlue"))
(when (file-exists-p (concat cd "klara.org")) (when (file-exists-p (concat cd "klara.org"))
(calfw-org-create-file-source "Klára" (concat cd "klara.org") "Gold")) (my/calfw-sorted-file-source "Klára" (concat cd "klara.org") "Gold"))
(when (file-exists-p (concat cd "family.org")) (when (file-exists-p (concat cd "family.org"))
(calfw-org-create-file-source "Rodina" (concat cd "family.org") "ForestGreen")))))) (my/calfw-sorted-file-source "Rodina" (concat cd "family.org") "ForestGreen"))))))
(calfw-open-calendar-buffer (calfw-open-calendar-buffer
:contents-sources sources :contents-sources sources
:view 'month :view 'month