gortium/dotfiles
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Committing before i loose it again!

Browse Source
This commit is contained in:
Thierry Pouplier
2026-02-09 14:57:11 -05:00
parent 28abca7572
commit 6939353f9c
2 changed files with 961 additions and 810 deletions
Download Patch File Download Diff File Expand all files Collapse all files

829
doom/.config/doom/README.org
View File

@@ -464,16 +464,18 @@ change ~org-directory~. It must be set before org loads!
) )
((org-agenda-tag-filter-preset '("+perso"))) ((org-agenda-tag-filter-preset '("+perso")))
) )
("wP" "THE PLAN" ("wP" "Installation Bombardier"
((agenda "" ((agenda ""
((org-agenda-span 60) ((org-agenda-span 60)
(org-agenda-start-day nil) (org-agenda-start-day "2026-01-29")
(org-agenda-overriding-header "📅 THE PLAN") (org-agenda-overriding-header "📅 Installation Bombardier")
(org-agenda-prefix-format " %?-12t%-12s") (org-agenda-prefix-format "%12t") ;; reserve time space
) (org-agenda-todo-keyword-format " %-12s ") ;; fixed-width TODO
) (org-agenda-tags-column -100) ;; right-align tags
) (org-agenda-time-grid nil)
((org-agenda-tag-filter-preset '("+work"))) )))
((org-agenda-tag-filter-preset '("+BA_ON_SITE")))
) )
) )
) )
@@ -570,237 +572,226 @@ fc --> UC3
* Elgantt * Elgantt
#+begin_src emacs-lisp #+begin_src emacs-lisp
(require 'cl-lib) ;; (require 'cl-lib)
(require 'dash) ;; (require 'dash)
(unless (fboundp 'first) (defalias 'first #'car)) ;; (unless (fboundp 'first) (defalias 'first #'car))
;; Clear rules to ensure the new global color logic takes effect immediately ;; ;; Clear rules to ensure the new global color logic takes effect immediately
(setq elgantt--display-rules nil) ;; (setq elgantt--display-rules nil)
(defface gortium/elgantt-weekend-face ;; (defface gortium/elgantt-weekend-face
'((t (:background "#32302f" :extend nil))) ;; '((t (:background "#32302f" :extend nil)))
"Gruvbox Dark0_Hard/Soft mix for subtle weekend stripes.") ;; "Gruvbox Dark0_Hard/Soft mix for subtle weekend stripes.")
(defun gortium/internal--month-to-num (name) ;; (defun gortium/internal--month-to-num (name)
"Convert month string to number safely." ;; "Convert month string to number safely."
(let ((case-fold-search t)) ;; (let ((case-fold-search t))
(cond ((string-match-p "Jan" name) 1) ((string-match-p "Feb" name) 2) ;; (cond ((string-match-p "Jan" name) 1) ((string-match-p "Feb" name) 2)
((string-match-p "Mar" name) 3) ((string-match-p "Apr" name) 4) ;; ((string-match-p "Mar" name) 3) ((string-match-p "Apr" name) 4)
((string-match-p "May" name) 5) ((string-match-p "Jun" name) 6) ;; ((string-match-p "May" name) 5) ((string-match-p "Jun" name) 6)
((string-match-p "Jul" name) 7) ((string-match-p "Aug" name) 8) ;; ((string-match-p "Jul" name) 7) ((string-match-p "Aug" name) 8)
((string-match-p "Sep" name) 9) ((string-match-p "Oct" name) 10) ;; ((string-match-p "Sep" name) 9) ((string-match-p "Oct" name) 10)
((string-match-p "Nov" name) 11) ((string-match-p "Dec" name) 12) (t 1)))) ;; ((string-match-p "Nov" name) 11) ((string-match-p "Dec" name) 12) (t 1))))
(defun gortium/elgantt-draw-weekend-guides () ;; (defun gortium/elgantt-draw-weekend-guides ()
"Draw weekend guides for the ENTIRE buffer once to prevent scroll lag." ;; "Draw weekend guides for the ENTIRE buffer once to prevent scroll lag."
(interactive) ;; (interactive)
(when (derived-mode-p 'elgantt-mode) ;; (when (derived-mode-p 'elgantt-mode)
(let* ((inhibit-modification-hooks t) ;; (let* ((inhibit-modification-hooks t)
(header-line-1 (save-excursion ;; (header-line-1 (save-excursion
(goto-char (point-min)) ;; (goto-char (point-min))
(buffer-substring-no-properties (line-beginning-position) (line-end-position)))) ;; (buffer-substring-no-properties (line-beginning-position) (line-end-position))))
(col-indices '()) ;; (col-indices '())
(search-pos 0)) ;; (search-pos 0))
(save-excursion ;; (save-excursion
(save-restriction ;; (save-restriction
(widen) ;; (widen)
;; 1. Clear ALL weekend overlays in the entire buffer ;; ;; 1. Clear ALL weekend overlays in the entire buffer
(remove-overlays (point-min) (point-max) 'gortium-weekend t) ;; (remove-overlays (point-min) (point-max) 'gortium-weekend t)
;; 2. Parse header once to find column indexes (Fast) ;; ;; 2. Parse header once to find column indexes (Fast)
(while (string-match "|[[:space:]]*\\([[:alpha:]]+\\)[[:space:]]+\\([0-9]\\{4\\}\\)" header-line-1 search-pos) ;; (while (string-match "|[[:space:]]*\\([[:alpha:]]+\\)[[:space:]]+\\([0-9]\\{4\\}\\)" header-line-1 search-pos)
(let* ((month-start-col (match-beginning 0)) ;; (let* ((month-start-col (match-beginning 0))
(month-name (match-string 1 header-line-1)) ;; (month-name (match-string 1 header-line-1))
(year (string-to-number (match-string 2 header-line-1))) ;; (year (string-to-number (match-string 2 header-line-1)))
(month-num (gortium/internal--month-to-num month-name)) ;; (month-num (gortium/internal--month-to-num month-name))
(next-pipe (string-match "|" header-line-1 (1+ month-start-col))) ;; (next-pipe (string-match "|" header-line-1 (1+ month-start-col)))
(month-width (if next-pipe (- next-pipe month-start-col 1) 31))) ;; (month-width (if next-pipe (- next-pipe month-start-col 1) 31)))
(dotimes (d month-width) ;; (dotimes (d month-width)
(let* ((day (1+ d)) ;; (let* ((day (1+ d))
(time (condition-case nil (encode-time 0 0 12 day month-num year) (error nil)))) ;; (time (condition-case nil (encode-time 0 0 12 day month-num year) (error nil))))
(when time ;; (when time
(let ((dow (nth 6 (decode-time time))) ;; (let ((dow (nth 6 (decode-time time)))
(actual-col (+ month-start-col 1 d))) ;; (actual-col (+ month-start-col 1 d)))
(when (member dow '(0 6)) ;; (when (member dow '(0 6))
(push actual-col col-indices)))))) ;; (push actual-col col-indices))))))
(setq search-pos (or next-pipe (length header-line-1))))) ;; (setq search-pos (or next-pipe (length header-line-1)))))
;; 3. Apply to the WHOLE buffer line by line ;; ;; 3. Apply to the WHOLE buffer line by line
(unless (null col-indices) ;; (unless (null col-indices)
(goto-char (point-min)) ;; (goto-char (point-min))
(forward-line 2) ;; Skip headers ;; (forward-line 2) ;; Skip headers
(while (not (eobp)) ;; (while (not (eobp))
(let ((line-end (line-end-position))) ;; (let ((line-end (line-end-position)))
(dolist (col col-indices) ;; (dolist (col col-indices)
(move-to-column col) ;; (move-to-column col)
(let ((p (point))) ;; (let ((p (point)))
;; Ensure we are still on the same line and at the correct column ;; ;; Ensure we are still on the same line and at the correct column
(when (and (< p line-end) (= (current-column) col)) ;; (when (and (< p line-end) (= (current-column) col))
(let ((ov (make-overlay p (1+ p)))) ;; (let ((ov (make-overlay p (1+ p))))
(overlay-put ov 'face 'gortium/elgantt-weekend-face) ;; (overlay-put ov 'face 'gortium/elgantt-weekend-face)
(overlay-put ov 'gortium-weekend t) ;; (overlay-put ov 'gortium-weekend t)
(overlay-put ov 'priority 100) ;; (overlay-put ov 'priority 100)
(overlay-put ov 'evaporate t)))))) ;; (overlay-put ov 'evaporate t))))))
(forward-line 1))))) ;; (forward-line 1)))))
(message "Weekend guides rendered for the whole buffer.")))) ;; (message "Weekend guides rendered for the whole buffer."))))
;; Run it only once when the buffer is loaded ;; ;; Run it only once when the buffer is loaded
(add-hook 'elgantt-mode-hook #'gortium/elgantt-draw-weekend-guides) ;; (add-hook 'elgantt-mode-hook #'gortium/elgantt-draw-weekend-guides)
(use-package! elgantt ;; (use-package! elgantt
:commands (elgantt-open elgantt-open-current-org-file) ;; :commands (elgantt-open elgantt-open-current-org-file)
:config ;; :config
;; --- 1. Environment & UI --- ;; ;; --- 1. Environment & UI ---
(add-hook 'elgantt-mode-hook ;; (add-hook 'elgantt-mode-hook
(lambda () ;; (lambda ()
(setq-local org-phscroll-mode nil) ;; (setq-local org-phscroll-mode nil)
(setq-local image-roll-mode nil) ;; (setq-local image-roll-mode nil)
(setq truncate-lines t))) ;; (setq truncate-lines t)))
(setq elgantt-start-date "2026-01-01") ;; (setq elgantt-start-date "2026-01-01")
(setq elgantt-header-column-offset 40 ;; (setq elgantt-header-column-offset 40
elgantt-header-type 'root ;; elgantt-header-type 'root
elgantt-show-header-depth t ;; elgantt-show-header-depth t
elgantt-insert-blank-line-between-top-level-header t ;; elgantt-insert-blank-line-between-top-level-header t
elgantt-startup-folded nil ;; elgantt-startup-folded nil
elgantt-draw-overarching-headers nil ;; elgantt-draw-overarching-headers nil
elgantt-scroll-to-current-month-at-startup t) ;; elgantt-scroll-to-current-month-at-startup nil)
(setq elgantt-user-set-color-priority-counter 0) ;; (setq elgantt-user-set-color-priority-counter 0)
;; --- 2. Effort Rule (With Weekend Extension) --- ;; (elgantt-create-display-rule draw-active-timestamp-range
(elgantt-create-display-rule draw-scheduled-to-effort-end ;; :parser ((override-color . ((when-let ((colors (org-entry-get (point) "ELGANTT-COLOR")))
:parser ((override-color . ((when-let ((colors (org-entry-get (point) "ELGANTT-COLOR"))) ;; (split-string colors " "))))
(split-string colors " ")))) ;; (range-dates . ((save-excursion
(elgantt-effort . ((org-entry-get (point) "EFFORT"))) ;; (org-back-to-heading t)
(wknd-days . ((when-let ((val (org-entry-get (point) "WEEKEND_DAYS"))) ;; (let ((limit (save-excursion (outline-next-heading) (point))))
(string-to-number val))))) ;; (when (re-search-forward "<\\([^>]+\\)>--<\\([^>]+\\)>" limit t)
:args (elgantt-scheduled elgantt-effort elgantt-org-id) ;; (list (match-string 1) (match-string 2))))))))
:body ((when (and elgantt-scheduled elgantt-effort) ;; :args (elgantt-org-id)
(let* ((start-ts (ts-parse elgantt-scheduled)) ;; :body ((when (and elgantt-org-id range-dates)
(raw-mins (org-duration-to-minutes elgantt-effort)) ;; (let* ((colors (or override-color '("#fabd2f" "#fe8019")))
;; Add the weekend jump days to the visual length ;; (s-str (substring (car range-dates) 0 10))
(total-days (+ (ceiling (/ (float raw-mins) 1440.0)) (or wknd-days 0))) ;; (e-str (substring (cadr range-dates) 0 10))
(p1 (save-excursion ;; (p1 (save-excursion (when (elgantt--goto-date s-str) (point))))
(elgantt--goto-date (ts-format "%Y-%m-%d" start-ts)) ;; (p2 (save-excursion (when (elgantt--goto-date e-str) (point)))))
(point))) ;; (when (and (numberp p1) (numberp p2))
(colors (or override-color '("#8ec07c" "#458588")))) ;; (elgantt--draw-gradient
(when (numberp p1) ;; (car colors) (cadr colors)
(if (<= total-days 1) ;; (truncate p1) (truncate p2) nil ;; <-- FIX: Removed (1+ ...) to stop overshoot
(elgantt--create-overlay (truncate p1) (1+ (truncate p1)) ;; `(priority ,(setq elgantt-user-set-color-priority-counter
`(face (:background ,(car colors)) ;; (1- elgantt-user-set-color-priority-counter))
priority ,(setq elgantt-user-set-color-priority-counter ;; :elgantt-user-overlay ,elgantt-org-id))))))))
(1- elgantt-user-set-color-priority-counter))
:elgantt-user-overlay ,elgantt-org-id))
;; FIX 1: compute p2 by date (handles "|" separators)
;; FIX 2: keep original "Rule of 2" behavior to avoid +1 day overshoot
(let* ((end-ts (ts-adjust 'day (- total-days 2) start-ts))
(p2 (save-excursion
(elgantt--goto-date (ts-format "%Y-%m-%d" end-ts))
(point))))
(when (numberp p2)
(elgantt--draw-gradient
(car colors) (cadr colors)
(truncate p1) (1+ (truncate p2)) nil
`(priority ,(setq elgantt-user-set-color-priority-counter
(1- elgantt-user-set-color-priority-counter))
:elgantt-user-overlay ,elgantt-org-id))))))))))
;; --- 3. Progress Bar --- ;; ;; --- 2. Effort Rule (With Weekend Extension) ---
(elgantt-create-display-rule pages-read-progress ;; ;; (elgantt-create-display-rule draw-scheduled-to-effort-end
:parser ((total-pages . ((--when-let (org-entry-get (point) "TOTAL_PAGES") (string-to-number it)))) ;; ;; :parser ((override-color . ((when-let ((colors (org-entry-get (point) "ELGANTT-COLOR")))
(pages-read . ((--when-let (org-entry-get (point) "PAGES_READ") (string-to-number it))))) ;; ;; (split-string colors " "))))
:args (elgantt-deadline elgantt-scheduled) ;; ;; (elgantt-effort . ((org-entry-get (point) "EFFORT")))
:body ((when (and elgantt-deadline elgantt-scheduled total-pages pages-read) ;; ;; (wknd-days . ((when-let ((val (org-entry-get (point) "WEEKEND_DAYS")))
(let* ((start (save-excursion (elgantt--goto-date elgantt-scheduled) (point))) ;; ;; (string-to-number val)))))
(end (save-excursion (elgantt--goto-date elgantt-deadline) (point))) ;; ;; :args (elgantt-scheduled elgantt-effort elgantt-org-id)
(percent (/ (float pages-read) (float total-pages)))) ;; ;; :body ((when (and elgantt-scheduled elgantt-effort)
(when (and (numberp start) (numberp end)) ;; ;; (let* ((start-ts (ts-parse elgantt-scheduled))
(elgantt--draw-progress-bar "#98be65" "#ff6c6b" ;; ;; (raw-mins (org-duration-to-minutes elgantt-effort))
(truncate start) (truncate end) percent)))))) ;; ;; ;; Add the weekend jump days to the visual length
;; ;; (total-days (+ (ceiling (/ (float raw-mins) 1440.0)) (or wknd-days 0)))
;; ;; (p1 (save-excursion
;; ;; (elgantt--goto-date (ts-format "%Y-%m-%d" start-ts))
;; ;; (point)))
;; ;; (colors (or override-color '("#8ec07c" "#458588"))))
;; ;; (when (numberp p1)
;; ;; (if (<= total-days 1)
;; ;; (elgantt--create-overlay (truncate p1) (1+ (truncate p1))
;; ;; `(face (:background ,(car colors))
;; ;; priority ,(setq elgantt-user-set-color-priority-counter
;; ;; (1- elgantt-user-set-color-priority-counter))
;; ;; :elgantt-user-overlay ,elgantt-org-id))
;; ;; ;; FIX 1: compute p2 by date (handles "|" separators)
;; ;; ;; FIX 2: keep original "Rule of 2" behavior to avoid +1 day overshoot
;; ;; (let* ((end-ts (ts-adjust 'day (- total-days 2) start-ts))
;; ;; (p2 (save-excursion
;; ;; (elgantt--goto-date (ts-format "%Y-%m-%d" end-ts))
;; ;; (point))))
;; ;; (when (numberp p2)
;; ;; (elgantt--draw-gradient
;; ;; (car colors) (cadr colors)
;; ;; (truncate p1) (1+ (truncate p2)) nil
;; ;; `(priority ,(setq elgantt-user-set-color-priority-counter
;; ;; (1- elgantt-user-set-color-priority-counter))
;; ;; :elgantt-user-overlay ,elgantt-org-id))))))))))
;; --- 4. Blocker Interaction (Smart Append) --- ;; (elgantt-create-display-rule draw-blocker-lines
(require 'elgantt-interaction) ;; :parser ((blocker-raw . ((org-entry-get (point) "BLOCKER"))))
(elgantt--selection-rule :name mark-blocker ;; :args (elgantt-org-id elgantt-scheduled)
:selection-number 2 ;; :body ((when (and elgantt-org-id blocker-raw (not (string-empty-p blocker-raw)))
:selection-messages ((1 . "Select the BLOCKING task (Cause)") ;; ;; 1. GET DESTINATION (Start of current task)
(2 . "Select the BLOCKED task (Effect)")) ;; ;; We use the built-in elgantt-scheduled arg if available, it's faster and safer.
:execution-functions ;; (let* ((p-dest (save-excursion
((1 . ((elgantt-with-point-at-orig-entry nil (org-id-get-create)))) ;; (let ((d-start (or (when (stringp elgantt-scheduled) (substring elgantt-scheduled 0 10))
(2 . ((let* ((new-id return-val) ;; (elgantt-with-point-at-orig-entry nil
(current (elgantt-with-point-at-orig-entry nil (org-entry-get (point) "BLOCKER")))) ;; (save-excursion
(elgantt-with-point-at-orig-entry nil ;; (org-back-to-heading t)
(if (and current (string-match "ids(\\(.*?\\))" current)) ;; (when (re-search-forward "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" (line-end-position) t)
(let ((existing (match-string 1 current))) ;; (match-string 1)))))))
(org-set-property "BLOCKER" (format "ids(%s %s)" existing new-id))) ;; (when (and d-start (elgantt--goto-date d-start)) (point))))))
(org-set-property "BLOCKER" (format "ids(%s)" new-id)))
(message "Added blocker: %s" new-id)))))))
;; --- 5. Blocker Lines (Surgical Alignment Fix) --- ;; (when (numberp p-dest)
(elgantt-create-display-rule draw-blocker-lines ;; (let ((ids-string (if (string-match "ids(\\(.*?\\))" blocker-raw) (match-string 1 blocker-raw) blocker-raw))
:parser ((blocker-raw . ((org-entry-get (point) "BLOCKER")))) ;; (id-list (split-string (if (string-match "ids(\\(.*?\\))" blocker-raw) (match-string 1 blocker-raw) blocker-raw) "[ ,]+" t)))
:args (elgantt-org-id) ;; (dolist (blocker-id id-list)
:body ((when (and blocker-raw (not (string-empty-p blocker-raw))) ;; (save-excursion
(let* ((p-blocked (point)) ;; (when (elgantt--goto-id blocker-id)
(ids-string (if (string-match "ids(\\(.*?\\))" blocker-raw) ;; (let ((d-end-str nil)
(match-string 1 blocker-raw) ;; (row-start (line-beginning-position))
blocker-raw)) ;; (row-end (line-end-position)))
(id-list (split-string ids-string "[ ,]+" t))) ;; ;; 2. GET BLOCKER END DATE
(dolist (blocker-id id-list) ;; (elgantt-with-point-at-orig-entry nil
(save-excursion ;; (save-excursion
(when (elgantt--goto-id blocker-id) ;; (org-back-to-heading t)
(let* ((blocker-data (elgantt-with-point-at-orig-entry nil ;; (let ((limit (save-excursion (outline-next-heading) (point))))
(list (org-entry-get (point) "SCHEDULED") ;; (if (re-search-forward "<[^>]+>--<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" limit t)
(org-entry-get (point) "EFFORT") ;; (setq d-end-str (match-string 1))
(org-entry-get (point) "WEEKEND_DAYS")))) ;; (let ((s (org-entry-get (point) "SCHEDULED"))
(b-sched (nth 0 blocker-data)) ;; (e (org-entry-get (point) "EFFORT"))
(b-effort (nth 1 blocker-data)) ;; (w (string-to-number (or (org-entry-get (point) "WEEKEND_DAYS") "0"))))
(b-wknd (when (nth 2 blocker-data) (string-to-number (nth 2 blocker-data))))) ;; (when (and s e)
(when (and b-sched b-effort) ;; (setq d-end-str (ts-format "%Y-%m-%d" (ts-adjust 'day (1- (+ (ceiling (/ (float (org-duration-to-minutes e)) 1440.0)) w)) (ts-parse s))))))))))
(let* ((start-ts (ts-parse b-sched))
(raw-mins (org-duration-to-minutes b-effort))
;; Visual length must match the Effort Rule exactly
(total-days (+ (ceiling (/ (float raw-mins) 1440.0)) (or b-wknd 0)))
(p-start (save-excursion
(elgantt--goto-date (ts-format "%Y-%m-%d" start-ts))
(point))))
(when (and (numberp p-start) (numberp p-blocked))
;; Point to the LAST DAY of the task bar
(let* ((end-date-ts (ts-adjust 'day (max 0 (1- total-days)) start-ts))
(p-line-start (save-excursion
(elgantt--goto-date (ts-format "%Y-%m-%d" end-date-ts))
(point))))
(when (numberp p-line-start)
;; DRAW: From p-line-start to p-blocked
;; Note: Removed the (1+) to pull the line back by one day
(elgantt--draw-line (truncate p-line-start)
(truncate p-blocked)
"#b8bb26"))))))))))))))
;; --- 6. Hashtag Navigation --- ;; ;; 3. DRAW
(elgantt-create-action follow-hashtag-link-forward ;; (when d-end-str
:args (elgantt-alltags) :binding "C-M-f" ;; (save-excursion
:body ((when-let* ((hashtag (--first (s-starts-with-p "#" it) elgantt-alltags)) ;; (elgantt--goto-date d-end-str)
(match (elgantt--next-match :elgantt-alltags hashtag))) ;; (let ((p-source (point)))
(goto-char (car match))))) ;; (if (and (>= p-source row-start) (<= p-source row-end))
;; (elgantt--draw-line (truncate p-source) (truncate p-dest) "#b8bb26")
;; ;; Force to row if it jumped
;; (let ((col-offset (- p-source (save-excursion (goto-char p-source) (line-beginning-position)))))
;; (goto-char row-start)
;; (forward-char col-offset)
;; (elgantt--draw-line (point) (truncate p-dest) "#b8bb26")))))))))))))))
;; )
(elgantt-create-action follow-hashtag-link-backward ;; (defun elgantt-open-current-org-file ()
:args (elgantt-alltags) :binding "C-M-b" ;; (interactive)
:body ((when-let* ((hashtag (--first (s-starts-with-p "#" it) elgantt-alltags)) ;; (if-let ((file (buffer-file-name)))
(match (elgantt--previous-match :elgantt-alltags hashtag))) ;; (progn
(goto-char (car match))))) ;; (setq elgantt-agenda-files (list file))
) ;; (elgantt--reset-org-ql-cache)
;; (elgantt-open))
(defun elgantt-open-current-org-file () ;; (message "No file!")))
(interactive)
(if-let ((file (buffer-file-name)))
(progn
(setq elgantt-agenda-files (list file))
(elgantt--reset-org-ql-cache)
(elgantt-open))
(message "No file!")))
#+end_src #+end_src
#+RESULTS: #+RESULTS:
@@ -2087,6 +2078,9 @@ www.tdnde.com \\\\
#+end_src #+end_src
** TODO Fix noter if needed ** TODO Fix noter if needed
:PROPERTIES:
:ID: 150ae9d2-df33-41d2-9cc1-f22d95659fed
:END:
* PDF-Tools * PDF-Tools
Really useful to be able to have a buffer with notes, and another with the official PDF doc Really useful to be able to have a buffer with notes, and another with the official PDF doc
@@ -2210,7 +2204,7 @@ If FILE is nil, refile in the current file."
#+begin_src emacs-lisp #+begin_src emacs-lisp
;;; ============================================================ ;;; ============================================================
;;; GORTIUM — Org chain scheduler (timestamp-based, no duplicates) ;;; GORTIUM — Org chain scheduler (Safe & Optimized with Debugging)
;;; ============================================================ ;;; ============================================================
(require 'org) (require 'org)
@@ -2254,9 +2248,30 @@ If FILE is nil, refile in the current file."
(nthcdr 3 (decode-time next))))))) (nthcdr 3 (decode-time next)))))))
(t t1)))) (t t1))))
;; ------------------------------------------------------------ (defun gortium/org--get-range-start (pos)
;; Helper: Calculate task span using EFFORT (hour-grained) "Extract the start timestamp from an existing range like <A>--<B>.
;; ------------------------------------------------------------ Returns nil if no range found (safe, non-blocking)."
(save-excursion
(goto-char pos)
(org-back-to-heading t)
(let ((end (save-excursion
(or (ignore-errors (outline-next-heading))
(point-max))
(point)))
(start-time nil))
(save-restriction
(narrow-to-region (point) end)
(goto-char (point-min))
;; Look for range in first 50 lines only (safety limit)
(let ((search-limit (save-excursion
(forward-line 50)
(point))))
(when (re-search-forward "<\\([^>]+\\)>--<[^>]+>" search-limit t)
(condition-case nil
(setq start-time (org-time-string-to-time (match-string 1)))
(error nil)))))
start-time)))
(defun gortium/internal--calculate-task-span (start-time effort-str) (defun gortium/internal--calculate-task-span (start-time effort-str)
"Return a list (END-TIME WEEKEND-DAYS) for given START-TIME and EFFORT string." "Return a list (END-TIME WEEKEND-DAYS) for given START-TIME and EFFORT string."
(if (or (null effort-str) (string-empty-p effort-str)) (if (or (null effort-str) (string-empty-p effort-str))
@@ -2268,8 +2283,11 @@ If FILE is nil, refile in the current file."
(cursor start-time) (cursor start-time)
(wknd-count 0) (wknd-count 0)
(day-start 8) (day-start 8)
(day-end 16)) (day-end 16)
(while (> total-work-mins 0) (safety-counter 0)
(max-iterations 1000)) ;; Safety limit
(while (and (> total-work-mins 0) (< safety-counter max-iterations))
(setq safety-counter (1+ safety-counter))
(let* ((decoded (decode-time cursor)) (let* ((decoded (decode-time cursor))
(h (nth 2 decoded)) (h (nth 2 decoded))
(m (nth 1 decoded)) (m (nth 1 decoded))
@@ -2293,183 +2311,242 @@ If FILE is nil, refile in the current file."
(t ;; spill to next day (t ;; spill to next day
(setq total-work-mins (- total-work-mins mins-left-today)) (setq total-work-mins (- total-work-mins mins-left-today))
(setq cursor (time-add cursor (seconds-to-time (* mins-left-today 60)))))))) (setq cursor (time-add cursor (seconds-to-time (* mins-left-today 60))))))))
(when (>= safety-counter max-iterations)
(message "WARNING: calculate-task-span hit iteration limit for effort %s" effort-str))
(list cursor wknd-count)))) (list cursor wknd-count))))
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
;; Helper: Find dependency end time ;; Helper: Find dependency end time
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
(defun gortium/internal--get-blocker-end (blocker-str current-pos task-end-map) (defun gortium/internal--get-blocker-end (blocker-str task-end-map)
"Return the latest end time among the dependencies listed in BLOCKER-STR." "Return latest end time only if blockers are DONE or have been recalculated."
(let ((clean (s-trim (format "%s" blocker-str))) (let ((clean (s-trim (format "%s" blocker-str)))
(latest-time nil)) (latest-time nil)
(cond (all-resolved t))
((string-match-p "previous-sibling" clean) (when (and (string-match "ids(\\(.*?\\))" clean)
(save-excursion (not (string-empty-p (s-trim (match-string 1 clean)))))
(goto-char current-pos)
(let ((found nil))
(while (and (not found) (org-get-last-sibling))
(let* ((sid (org-id-get))
(end (when sid (gethash sid task-end-map))))
(when end
(setq latest-time end
found t)))))))
((string-match-p "parent" clean)
(save-excursion
(goto-char current-pos)
(when (org-up-heading-safe)
(setq latest-time (gethash (org-id-get) task-end-map)))))
((string-match "ids(\\(.*?\\))" clean)
(dolist (tid (split-string (match-string 1 clean) "[ ,]+" t)) (dolist (tid (split-string (match-string 1 clean) "[ ,]+" t))
(let ((tend (gethash (replace-regexp-in-string "[\"']\\|id:" "" tid) task-end-map))) (let* ((clean-id (replace-regexp-in-string "[\"']\\|id:" "" tid))
(when (and tend (pos (org-id-find clean-id t))
(or (null latest-time) (computed-end (gethash clean-id task-end-map))
(time-less-p latest-time tend))) (blocker-end
(setq latest-time tend)))))) (cond
latest-time)) ;; 1) Use the new time we just calculated in this run (Priority!)
(computed-end computed-end)
;; ------------------------------------------------------------ ;; 2) If it's DONE, use the CLOSED timestamp
;; Helper: Get earliest timestamp in entry ((and pos (org-entry-get pos "CLOSED"))
;; ------------------------------------------------------------ (org-time-string-to-time (org-entry-get pos "CLOSED")))
(defun gortium/org--get-anchor-time ()
"Return the earliest timestamp in current entry, or nil."
(save-excursion
(org-back-to-heading t)
(let ((limit (save-excursion (outline-next-heading) (point)))
(best nil))
(while (re-search-forward org-ts-regexp-both limit t 1)
(let ((ts (org-time-string-to-time (match-string 0))))
(when (or (null best) (time-less-p ts best))
(setq best ts))))
best)))
;; ------------------------------------------------------------ ;; 3) If it's FIXED, use the existing range/scheduled time
;; Helper: Write timestamp range (NO SCHEDULED) ((and pos (string-equal "t" (org-entry-get pos "FIXED")))
;; ------------------------------------------------------------ (or (gortium/org--get-range-start pos) ;; Note: This needs range end logic, but start is a fallback
(defun gortium/internal--update-properties (pos start wknd id end task-end-map &optional fixed original-start) (org-get-scheduled-time pos)))
"Update WEEKEND_DAYS and write the time range at POS.
For fixed tasks, ORIGINAL-START is preserved. OLD SCHEDULED/range lines are removed. ;; Otherwise: We MUST wait for this blocker to be recalculated
The range is inserted directly below the heading, before any drawers." (t nil))))
(if blocker-end
(setq latest-time (if (or (null latest-time) (time-less-p latest-time blocker-end))
blocker-end latest-time))
(setq all-resolved nil)))))
(when all-resolved latest-time)))
(defun gortium/internal--update-properties (pos start wknd id end task-end-map)
"Heals the property drawer, updates values, and fixes vertical spacing without leaking newlines."
(message "[DEBUG] enter update-properties for %s" id)
(save-excursion (save-excursion
(goto-char pos) (goto-char pos)
(org-show-entry)
;; Update WEEKEND_DAYS property
(if (and wknd (> wknd 0))
(org-entry-put (point) "WEEKEND_DAYS" (number-to-string wknd))
(org-entry-delete (point) "WEEKEND_DAYS"))
;; Remove old ranges or SCHEDULED lines
(save-excursion
(org-back-to-heading t) (org-back-to-heading t)
(let ((limit (save-excursion (outline-next-heading) (point)))) (let* ((subtree-start (point))
(forward-line 1) (subtree-end (save-excursion (org-end-of-subtree t) (point))))
(while (< (point) limit)
(cond
((looking-at "^[ \t]*SCHEDULED:") (delete-region (point-at-bol) (1+ (point-at-eol))))
((looking-at "^[ \t]*<.*>--<.*>") (delete-region (point-at-bol) (1+ (point-at-eol))))
((looking-at "^\\*+") (goto-char limit))
((looking-at "^[ \t]*:") (goto-char (line-beginning-position))
(setq limit (point)))
(t (forward-line 1))))))
;; Determine insertion point: after heading, before drawers (save-restriction
(let ((insert-point (save-excursion (narrow-to-region subtree-start subtree-end)
(org-back-to-heading t)
(forward-line 1)
(point)))
(range-start (if fixed original-start start))) ;; preserve start if fixed
;; Insert range
(goto-char insert-point)
(insert (format "%s--%s"
(format-time-string "<%Y-%m-%d %a %H:%M>" range-start)
(format-time-string "<%Y-%m-%d %a %H:%M>" end))
"\n"))
;; Update task-end-map ;; --- STEP 1: HEAL THE DRAWER ---
(goto-char (point-min))
(forward-line 1)
(while (looking-at "^[ \t]*\\(CLOSED:\\|SCHEDULED:\\|DEADLINE:\\)")
(forward-line 1))
(when (looking-at "^[ \t]*:PROPERTIES:[ \t]*$")
(let ((drawer-start (point)))
(when (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)
(let ((drawer-end (match-end 0)))
(save-restriction
(narrow-to-region drawer-start drawer-end)
(goto-char (point-min))
(forward-line 1)
(while (re-search-forward "^[ \t]*$" nil t)
(delete-region (line-beginning-position)
(min (1+ (line-end-position)) (point-max)))))))))
;; --- STEP 2: UPDATE PROPERTY ---
(org-entry-put nil "WEEKEND_DAYS" (number-to-string (or wknd 0)))
;; --- STEP 3: REMOVE OLD RANGE ---
(goto-char (point-min))
(while (re-search-forward "^[ \t]*<.+>--<.+>[ \t]*\n?" nil t)
(replace-match ""))
;; --- STEP 4: FIND INSERTION POINT ---
(goto-char (point-min))
(forward-line 1)
(while (looking-at "^[ \t]*\\(CLOSED:\\|SCHEDULED:\\|DEADLINE:\\)")
(forward-line 1))
(while (looking-at "^[ \t]*:\\([A-Z_]+\\):[ \t]*$")
(when (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)
(forward-line 1)))
;; Delete any existing blank lines at the insertion point
(while (and (looking-at "^[ \t]*$") (not (eobp)))
(delete-region (line-beginning-position) (line-beginning-position 2)))
;; --- STEP 5: INSERT RANGE ---
;; Ensure range starts on a new line and ends with exactly one newline
(unless (bolp) (insert "\n"))
(insert (format "<%s>--<%s>\n"
(format-time-string "%Y-%m-%d %a %H:%M" start)
(format-time-string "%Y-%m-%d %a %H:%M" end)))
;; --- STEP 6: CLEAN UP REMAINING WHITESPACE WITHIN TASK ---
(while (and (looking-at "^[ \t]*$") (not (eobp)))
(delete-region (line-beginning-position) (line-beginning-position 2))))
;; --- STEP 7: NORMALIZE SPACING BETWEEN TASKS ---
;; Instead of inserting a newline blindly, we ensure exactly one blank line
;; exists between this subtree's end and the next heading.
(goto-char (org-end-of-subtree t))
(let ((post-subtree (point)))
(save-restriction
(widen)
(goto-char post-subtree)
(delete-blank-lines)
;; Only insert a blank line if we aren't at the end of the buffer
(unless (eobp)
(insert "\n")))))
(message "[DEBUG] exit update-properties")
(puthash id end task-end-map))) (puthash id end task-end-map)))
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
;; MAIN FUNCTION ;; Helper: Detect circular dependencies
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
(defun gortium/internal--detect-circular-deps (tasks)
"Check for circular dependencies in TASKS.
Returns list of task IDs involved in cycles, or nil if no cycles found."
(let ((graph (make-hash-table :test 'equal))
(visiting (make-hash-table :test 'equal))
(visited (make-hash-table :test 'equal))
(cycles nil))
;; Build dependency graph
(dolist (task tasks)
(pcase-let ((`(,_pos ,id ,_effort ,blocker ,_fixed ,_sched ,_rng-start ,_offset ,_state) task))
(when (and blocker (not (string-empty-p (s-trim blocker))))
(when (string-match "ids(\\(.*?\\))" blocker)
(let ((deps (split-string (match-string 1 blocker) "[ ,]+" t)))
(puthash id (mapcar (lambda (tid)
(replace-regexp-in-string "[\"']\\|id:" "" tid))
deps)
graph))))))
;; DFS to detect cycles
(cl-labels ((dfs (node path)
(cond
((gethash node visiting)
;; Found a cycle
(push node cycles)
t)
((gethash node visited)
nil)
(t
(puthash node t visiting)
(dolist (dep (gethash node graph))
(when (dfs dep (cons node path))
(push node cycles)))
(remhash node visiting)
(puthash node t visited)
nil))))
(maphash (lambda (node _deps)
(unless (gethash node visited)
(dfs node nil)))
graph))
(delete-dups cycles)))
(advice-add 'org-roam-db-sync :before
(lambda (&rest _)
(message "[DEBUG] org-roam-db-sync invoked")))
;; --- MAIN SCHEDULER ---
(defun gortium/org-schedule-subtree-chains () (defun gortium/org-schedule-subtree-chains ()
"Optimized scheduler: Ignores stale buffer ranges to ensure correct dependency flow."
(interactive) (interactive)
(save-excursion (message "=== Starting Gortium Scheduler ===")
(message "--- Starting Global Gantt Scheduler ---")
(let ((all-tasks '()) ;; 1. Global deactivations to prevent the "Parser Error"
(let ((org-element-use-cache nil)
(all-tasks '())
(task-end-times (make-hash-table :test 'equal)) (task-end-times (make-hash-table :test 'equal))
(task-end-for-blockers (make-hash-table :test 'equal))) (start-time (current-time)))
;; COLLECTION
;; 2. COLLECTION
(org-map-entries (org-map-entries
(lambda () (lambda ()
(let ((state (org-get-todo-state))) (when (org-get-todo-state)
(when state
(let* ((pos (point-marker)) (let* ((pos (point-marker))
(id (org-id-get-create)) (id (or (org-id-get) (org-id-get-create))))
(effort (org-entry-get (point) "EFFORT")) (push (list (current-buffer) pos id
(blocker (org-entry-get (point) "BLOCKER")) (org-entry-get pos "EFFORT")
(fixed (org-entry-get (point) "FIXED")) (org-entry-get pos "BLOCKER")
(anchor (or (org-get-scheduled-time (point)) (org-entry-get pos "FIXED")
(gortium/org--get-anchor-time))) (org-get-scheduled-time pos)
(closed (org-entry-get (point) "CLOSED")) (org-entry-get pos "OFFSET_DAYS"))
(offset (org-entry-get (point) "OFFSET_DAYS"))) all-tasks))))
(when (or effort blocker fixed (string= state "DONE"))
(push (list pos id effort blocker fixed anchor offset state closed)
all-tasks))))))
nil nil) nil nil)
(setq all-tasks (nreverse all-tasks)) (setq all-tasks (nreverse all-tasks))
;; PASS 1: DONE & FIXED ;; 3. THE LOOP
(dolist (task all-tasks) (let* ((remaining all-tasks)
(pcase-let ((`(,pos ,id ,effort ,_ ,fixed ,anchor ,_ ,state ,closed) task)) (limit (* 20 (length remaining)))
(cond
;; DONE: compute range like normal, CLOSED is used for blockers
((string= state "DONE")
(let* ((start (or anchor (current-time)))
(span (gortium/internal--calculate-task-span start effort)))
(gortium/internal--update-properties pos (car span) (cadr span) id (car span)
task-end-times))
;; Store CLOSED for dependencies
(when closed
(puthash id (org-time-string-to-time closed) task-end-for-blockers)))
;; FIXED tasks
((and fixed anchor)
(let* ((span (gortium/internal--calculate-task-span anchor effort)))
(gortium/internal--update-properties pos anchor (cadr span) id (car span)
task-end-times)))
;; nothing else here
)))
;; PASS 2: CHAINS
(let ((remaining (cl-remove-if (lambda (t)
(gethash (nth 1 t) task-end-times))
all-tasks))
(limit (* 5 (length all-tasks)))
(iter 0)) (iter 0))
(while (and remaining (< iter limit))
(cl-incf iter)
(let ((done '()))
(dolist (task remaining)
(pcase-let ((`(,pos ,id ,effort ,blocker ,_ ,_ ,offset ,state ,closed) task))
;; Determine dependency end
(let* ((dep (or (gortium/internal--get-blocker-end blocker pos
task-end-times)
(and (string= state "DONE")
(gethash id task-end-for-blockers)))))
(when dep
(let* ((off (if offset (string-to-number offset) 0))
(start (gortium/internal--snap-to-working-hours
(time-add dep (days-to-time off))))
(span (gortium/internal--calculate-task-span start effort)))
;; FIXED tasks: keep start
(if (and (not (string= state "DONE")) (org-entry-get pos "FIXED"))
(gortium/internal--update-properties pos anchor (cadr span) id (car span)
task-end-times)
(gortium/internal--update-properties pos (car span) (cadr span) id (car span)
task-end-times))
(push task done))))))
(setq remaining (cl-set-difference remaining done)))))
(message "--- Scheduler Finished ---")))) (while (and remaining (< iter limit))
(setq iter (1+ iter))
(let ((done-this-loop '()))
(dolist (task remaining)
(pcase-let ((`(,buf ,pos ,id ,effort ,blocker ,fixed ,sched ,offset) task))
(let* ((blocker-end (gortium/internal--get-blocker-end blocker task-end-times))
(has-blocker (and blocker (not (string-empty-p (s-trim blocker)))))
;; A task is ready if it's FIXED or all blockers are in the task-end-times map
(is-fixed (string-equal fixed "t"))
(ready (or is-fixed (not has-blocker) blocker-end)))
(when ready
(with-current-buffer buf
(org-element-with-disabled-cache
(let* ((off-days (if (stringp offset) (string-to-number offset) 0))
(base-start (cond (is-fixed (or (gortium/org--get-range-start pos) sched (current-time)))
(t (or blocker-end sched (current-time)))))
(final-start (if is-fixed base-start
(gortium/internal--snap-to-working-hours (time-add base-start (days-to-time off-days)))))
(span (gortium/internal--calculate-task-span final-start effort))
(final-end (car span))
(wknd (cadr span)))
(gortium/internal--update-properties pos final-start wknd id final-end task-end-times)
(push task done-this-loop))))))))
(setq remaining (cl-set-difference remaining done-this-loop))))
(org-element-cache-reset 'all)
(message "=== Scheduler completed (%d tasks, %d iterations) ===" (length all-tasks) iter))))
;; --------------------------------------------- ;; ---------------------------------------------
(defun gortium/org-ensure-task-properties () (defun gortium/org-ensure-task-properties ()
@@ -2482,7 +2559,7 @@ and ensure the standard property drawer exists without overwriting existing data
;; List of properties to ensure exist ;; List of properties to ensure exist
(props '("EFFORT" "BLOCKER" "FIXED" "WEEKEND_DAYS" (props '("EFFORT" "BLOCKER" "FIXED" "WEEKEND_DAYS"
"ASSIGNEE" "RESOURCES" "CATEGORY" "ASSIGNEE" "RESOURCES" "CATEGORY"
"DIMENTIONS" "WEIGHT"))) "DIMENTIONS" "WEIGHT" "OFFSET_DAYS")))
(org-map-entries (org-map-entries
(lambda () (lambda ()
;; This check returns true if the heading has ANY todo keyword ;; This check returns true if the heading has ANY todo keyword

826
doom/.config/doom/config.el
View File

@@ -334,16 +334,18 @@
) )
((org-agenda-tag-filter-preset '("+perso"))) ((org-agenda-tag-filter-preset '("+perso")))
) )
("wP" "THE PLAN" ("wP" "Installation Bombardier"
((agenda "" ((agenda ""
((org-agenda-span 60) ((org-agenda-span 60)
(org-agenda-start-day nil) (org-agenda-start-day "2026-01-29")
(org-agenda-overriding-header "📅 THE PLAN") (org-agenda-overriding-header "📅 Installation Bombardier")
(org-agenda-prefix-format " %?-12t%-12s") (org-agenda-prefix-format "%12t") ;; reserve time space
) (org-agenda-todo-keyword-format " %-12s ") ;; fixed-width TODO
) (org-agenda-tags-column -100) ;; right-align tags
) (org-agenda-time-grid nil)
((org-agenda-tag-filter-preset '("+work"))) )))
((org-agenda-tag-filter-preset '("+BA_ON_SITE")))
) )
) )
) )
@@ -398,237 +400,226 @@
;; Enable plantuml-mode for PlantUML files ;; Enable plantuml-mode for PlantUML files
(add-to-list 'auto-mode-alist '("\\.plantuml\\'" . plantuml-mode)) (add-to-list 'auto-mode-alist '("\\.plantuml\\'" . plantuml-mode))
(require 'cl-lib) ;; (require 'cl-lib)
(require 'dash) ;; (require 'dash)
(unless (fboundp 'first) (defalias 'first #'car)) ;; (unless (fboundp 'first) (defalias 'first #'car))
;; Clear rules to ensure the new global color logic takes effect immediately ;; ;; Clear rules to ensure the new global color logic takes effect immediately
(setq elgantt--display-rules nil) ;; (setq elgantt--display-rules nil)
(defface gortium/elgantt-weekend-face ;; (defface gortium/elgantt-weekend-face
'((t (:background "#32302f" :extend nil))) ;; '((t (:background "#32302f" :extend nil)))
"Gruvbox Dark0_Hard/Soft mix for subtle weekend stripes.") ;; "Gruvbox Dark0_Hard/Soft mix for subtle weekend stripes.")
(defun gortium/internal--month-to-num (name) ;; (defun gortium/internal--month-to-num (name)
"Convert month string to number safely." ;; "Convert month string to number safely."
(let ((case-fold-search t)) ;; (let ((case-fold-search t))
(cond ((string-match-p "Jan" name) 1) ((string-match-p "Feb" name) 2) ;; (cond ((string-match-p "Jan" name) 1) ((string-match-p "Feb" name) 2)
((string-match-p "Mar" name) 3) ((string-match-p "Apr" name) 4) ;; ((string-match-p "Mar" name) 3) ((string-match-p "Apr" name) 4)
((string-match-p "May" name) 5) ((string-match-p "Jun" name) 6) ;; ((string-match-p "May" name) 5) ((string-match-p "Jun" name) 6)
((string-match-p "Jul" name) 7) ((string-match-p "Aug" name) 8) ;; ((string-match-p "Jul" name) 7) ((string-match-p "Aug" name) 8)
((string-match-p "Sep" name) 9) ((string-match-p "Oct" name) 10) ;; ((string-match-p "Sep" name) 9) ((string-match-p "Oct" name) 10)
((string-match-p "Nov" name) 11) ((string-match-p "Dec" name) 12) (t 1)))) ;; ((string-match-p "Nov" name) 11) ((string-match-p "Dec" name) 12) (t 1))))
(defun gortium/elgantt-draw-weekend-guides () ;; (defun gortium/elgantt-draw-weekend-guides ()
"Draw weekend guides for the ENTIRE buffer once to prevent scroll lag." ;; "Draw weekend guides for the ENTIRE buffer once to prevent scroll lag."
(interactive) ;; (interactive)
(when (derived-mode-p 'elgantt-mode) ;; (when (derived-mode-p 'elgantt-mode)
(let* ((inhibit-modification-hooks t) ;; (let* ((inhibit-modification-hooks t)
(header-line-1 (save-excursion ;; (header-line-1 (save-excursion
(goto-char (point-min)) ;; (goto-char (point-min))
(buffer-substring-no-properties (line-beginning-position) (line-end-position)))) ;; (buffer-substring-no-properties (line-beginning-position) (line-end-position))))
(col-indices '()) ;; (col-indices '())
(search-pos 0)) ;; (search-pos 0))
(save-excursion ;; (save-excursion
(save-restriction ;; (save-restriction
(widen) ;; (widen)
;; 1. Clear ALL weekend overlays in the entire buffer ;; ;; 1. Clear ALL weekend overlays in the entire buffer
(remove-overlays (point-min) (point-max) 'gortium-weekend t) ;; (remove-overlays (point-min) (point-max) 'gortium-weekend t)
;; 2. Parse header once to find column indexes (Fast) ;; ;; 2. Parse header once to find column indexes (Fast)
(while (string-match "|[[:space:]]*\\([[:alpha:]]+\\)[[:space:]]+\\([0-9]\\{4\\}\\)" header-line-1 search-pos) ;; (while (string-match "|[[:space:]]*\\([[:alpha:]]+\\)[[:space:]]+\\([0-9]\\{4\\}\\)" header-line-1 search-pos)
(let* ((month-start-col (match-beginning 0)) ;; (let* ((month-start-col (match-beginning 0))
(month-name (match-string 1 header-line-1)) ;; (month-name (match-string 1 header-line-1))
(year (string-to-number (match-string 2 header-line-1))) ;; (year (string-to-number (match-string 2 header-line-1)))
(month-num (gortium/internal--month-to-num month-name)) ;; (month-num (gortium/internal--month-to-num month-name))
(next-pipe (string-match "|" header-line-1 (1+ month-start-col))) ;; (next-pipe (string-match "|" header-line-1 (1+ month-start-col)))
(month-width (if next-pipe (- next-pipe month-start-col 1) 31))) ;; (month-width (if next-pipe (- next-pipe month-start-col 1) 31)))
(dotimes (d month-width) ;; (dotimes (d month-width)
(let* ((day (1+ d)) ;; (let* ((day (1+ d))
(time (condition-case nil (encode-time 0 0 12 day month-num year) (error nil)))) ;; (time (condition-case nil (encode-time 0 0 12 day month-num year) (error nil))))
(when time ;; (when time
(let ((dow (nth 6 (decode-time time))) ;; (let ((dow (nth 6 (decode-time time)))
(actual-col (+ month-start-col 1 d))) ;; (actual-col (+ month-start-col 1 d)))
(when (member dow '(0 6)) ;; (when (member dow '(0 6))
(push actual-col col-indices)))))) ;; (push actual-col col-indices))))))
(setq search-pos (or next-pipe (length header-line-1))))) ;; (setq search-pos (or next-pipe (length header-line-1)))))
;; 3. Apply to the WHOLE buffer line by line ;; ;; 3. Apply to the WHOLE buffer line by line
(unless (null col-indices) ;; (unless (null col-indices)
(goto-char (point-min)) ;; (goto-char (point-min))
(forward-line 2) ;; Skip headers ;; (forward-line 2) ;; Skip headers
(while (not (eobp)) ;; (while (not (eobp))
(let ((line-end (line-end-position))) ;; (let ((line-end (line-end-position)))
(dolist (col col-indices) ;; (dolist (col col-indices)
(move-to-column col) ;; (move-to-column col)
(let ((p (point))) ;; (let ((p (point)))
;; Ensure we are still on the same line and at the correct column ;; ;; Ensure we are still on the same line and at the correct column
(when (and (< p line-end) (= (current-column) col)) ;; (when (and (< p line-end) (= (current-column) col))
(let ((ov (make-overlay p (1+ p)))) ;; (let ((ov (make-overlay p (1+ p))))
(overlay-put ov 'face 'gortium/elgantt-weekend-face) ;; (overlay-put ov 'face 'gortium/elgantt-weekend-face)
(overlay-put ov 'gortium-weekend t) ;; (overlay-put ov 'gortium-weekend t)
(overlay-put ov 'priority 100) ;; (overlay-put ov 'priority 100)
(overlay-put ov 'evaporate t)))))) ;; (overlay-put ov 'evaporate t))))))
(forward-line 1))))) ;; (forward-line 1)))))
(message "Weekend guides rendered for the whole buffer.")))) ;; (message "Weekend guides rendered for the whole buffer."))))
;; Run it only once when the buffer is loaded ;; ;; Run it only once when the buffer is loaded
(add-hook 'elgantt-mode-hook #'gortium/elgantt-draw-weekend-guides) ;; (add-hook 'elgantt-mode-hook #'gortium/elgantt-draw-weekend-guides)
(use-package! elgantt ;; (use-package! elgantt
:commands (elgantt-open elgantt-open-current-org-file) ;; :commands (elgantt-open elgantt-open-current-org-file)
:config ;; :config
;; --- 1. Environment & UI --- ;; ;; --- 1. Environment & UI ---
(add-hook 'elgantt-mode-hook ;; (add-hook 'elgantt-mode-hook
(lambda () ;; (lambda ()
(setq-local org-phscroll-mode nil) ;; (setq-local org-phscroll-mode nil)
(setq-local image-roll-mode nil) ;; (setq-local image-roll-mode nil)
(setq truncate-lines t))) ;; (setq truncate-lines t)))
(setq elgantt-start-date "2026-01-01") ;; (setq elgantt-start-date "2026-01-01")
(setq elgantt-header-column-offset 40 ;; (setq elgantt-header-column-offset 40
elgantt-header-type 'root ;; elgantt-header-type 'root
elgantt-show-header-depth t ;; elgantt-show-header-depth t
elgantt-insert-blank-line-between-top-level-header t ;; elgantt-insert-blank-line-between-top-level-header t
elgantt-startup-folded nil ;; elgantt-startup-folded nil
elgantt-draw-overarching-headers nil ;; elgantt-draw-overarching-headers nil
elgantt-scroll-to-current-month-at-startup t) ;; elgantt-scroll-to-current-month-at-startup nil)
(setq elgantt-user-set-color-priority-counter 0) ;; (setq elgantt-user-set-color-priority-counter 0)
;; --- 2. Effort Rule (With Weekend Extension) --- ;; (elgantt-create-display-rule draw-active-timestamp-range
(elgantt-create-display-rule draw-scheduled-to-effort-end ;; :parser ((override-color . ((when-let ((colors (org-entry-get (point) "ELGANTT-COLOR")))
:parser ((override-color . ((when-let ((colors (org-entry-get (point) "ELGANTT-COLOR"))) ;; (split-string colors " "))))
(split-string colors " ")))) ;; (range-dates . ((save-excursion
(elgantt-effort . ((org-entry-get (point) "EFFORT"))) ;; (org-back-to-heading t)
(wknd-days . ((when-let ((val (org-entry-get (point) "WEEKEND_DAYS"))) ;; (let ((limit (save-excursion (outline-next-heading) (point))))
(string-to-number val))))) ;; (when (re-search-forward "<\\([^>]+\\)>--<\\([^>]+\\)>" limit t)
:args (elgantt-scheduled elgantt-effort elgantt-org-id) ;; (list (match-string 1) (match-string 2))))))))
:body ((when (and elgantt-scheduled elgantt-effort) ;; :args (elgantt-org-id)
(let* ((start-ts (ts-parse elgantt-scheduled)) ;; :body ((when (and elgantt-org-id range-dates)
(raw-mins (org-duration-to-minutes elgantt-effort)) ;; (let* ((colors (or override-color '("#fabd2f" "#fe8019")))
;; Add the weekend jump days to the visual length ;; (s-str (substring (car range-dates) 0 10))
(total-days (+ (ceiling (/ (float raw-mins) 1440.0)) (or wknd-days 0))) ;; (e-str (substring (cadr range-dates) 0 10))
(p1 (save-excursion ;; (p1 (save-excursion (when (elgantt--goto-date s-str) (point))))
(elgantt--goto-date (ts-format "%Y-%m-%d" start-ts)) ;; (p2 (save-excursion (when (elgantt--goto-date e-str) (point)))))
(point))) ;; (when (and (numberp p1) (numberp p2))
(colors (or override-color '("#8ec07c" "#458588")))) ;; (elgantt--draw-gradient
(when (numberp p1) ;; (car colors) (cadr colors)
(if (<= total-days 1) ;; (truncate p1) (truncate p2) nil ;; <-- FIX: Removed (1+ ...) to stop overshoot
(elgantt--create-overlay (truncate p1) (1+ (truncate p1)) ;; `(priority ,(setq elgantt-user-set-color-priority-counter
`(face (:background ,(car colors)) ;; (1- elgantt-user-set-color-priority-counter))
priority ,(setq elgantt-user-set-color-priority-counter ;; :elgantt-user-overlay ,elgantt-org-id))))))))
(1- elgantt-user-set-color-priority-counter))
:elgantt-user-overlay ,elgantt-org-id))
;; FIX 1: compute p2 by date (handles "|" separators)
;; FIX 2: keep original "Rule of 2" behavior to avoid +1 day overshoot
(let* ((end-ts (ts-adjust 'day (- total-days 2) start-ts))
(p2 (save-excursion
(elgantt--goto-date (ts-format "%Y-%m-%d" end-ts))
(point))))
(when (numberp p2)
(elgantt--draw-gradient
(car colors) (cadr colors)
(truncate p1) (1+ (truncate p2)) nil
`(priority ,(setq elgantt-user-set-color-priority-counter
(1- elgantt-user-set-color-priority-counter))
:elgantt-user-overlay ,elgantt-org-id))))))))))
;; --- 3. Progress Bar --- ;; ;; --- 2. Effort Rule (With Weekend Extension) ---
(elgantt-create-display-rule pages-read-progress ;; ;; (elgantt-create-display-rule draw-scheduled-to-effort-end
:parser ((total-pages . ((--when-let (org-entry-get (point) "TOTAL_PAGES") (string-to-number it)))) ;; ;; :parser ((override-color . ((when-let ((colors (org-entry-get (point) "ELGANTT-COLOR")))
(pages-read . ((--when-let (org-entry-get (point) "PAGES_READ") (string-to-number it))))) ;; ;; (split-string colors " "))))
:args (elgantt-deadline elgantt-scheduled) ;; ;; (elgantt-effort . ((org-entry-get (point) "EFFORT")))
:body ((when (and elgantt-deadline elgantt-scheduled total-pages pages-read) ;; ;; (wknd-days . ((when-let ((val (org-entry-get (point) "WEEKEND_DAYS")))
(let* ((start (save-excursion (elgantt--goto-date elgantt-scheduled) (point))) ;; ;; (string-to-number val)))))
(end (save-excursion (elgantt--goto-date elgantt-deadline) (point))) ;; ;; :args (elgantt-scheduled elgantt-effort elgantt-org-id)
(percent (/ (float pages-read) (float total-pages)))) ;; ;; :body ((when (and elgantt-scheduled elgantt-effort)
(when (and (numberp start) (numberp end)) ;; ;; (let* ((start-ts (ts-parse elgantt-scheduled))
(elgantt--draw-progress-bar "#98be65" "#ff6c6b" ;; ;; (raw-mins (org-duration-to-minutes elgantt-effort))
(truncate start) (truncate end) percent)))))) ;; ;; ;; Add the weekend jump days to the visual length
;; ;; (total-days (+ (ceiling (/ (float raw-mins) 1440.0)) (or wknd-days 0)))
;; ;; (p1 (save-excursion
;; ;; (elgantt--goto-date (ts-format "%Y-%m-%d" start-ts))
;; ;; (point)))
;; ;; (colors (or override-color '("#8ec07c" "#458588"))))
;; ;; (when (numberp p1)
;; ;; (if (<= total-days 1)
;; ;; (elgantt--create-overlay (truncate p1) (1+ (truncate p1))
;; ;; `(face (:background ,(car colors))
;; ;; priority ,(setq elgantt-user-set-color-priority-counter
;; ;; (1- elgantt-user-set-color-priority-counter))
;; ;; :elgantt-user-overlay ,elgantt-org-id))
;; ;; ;; FIX 1: compute p2 by date (handles "|" separators)
;; ;; ;; FIX 2: keep original "Rule of 2" behavior to avoid +1 day overshoot
;; ;; (let* ((end-ts (ts-adjust 'day (- total-days 2) start-ts))
;; ;; (p2 (save-excursion
;; ;; (elgantt--goto-date (ts-format "%Y-%m-%d" end-ts))
;; ;; (point))))
;; ;; (when (numberp p2)
;; ;; (elgantt--draw-gradient
;; ;; (car colors) (cadr colors)
;; ;; (truncate p1) (1+ (truncate p2)) nil
;; ;; `(priority ,(setq elgantt-user-set-color-priority-counter
;; ;; (1- elgantt-user-set-color-priority-counter))
;; ;; :elgantt-user-overlay ,elgantt-org-id))))))))))
;; --- 4. Blocker Interaction (Smart Append) --- ;; (elgantt-create-display-rule draw-blocker-lines
(require 'elgantt-interaction) ;; :parser ((blocker-raw . ((org-entry-get (point) "BLOCKER"))))
(elgantt--selection-rule :name mark-blocker ;; :args (elgantt-org-id elgantt-scheduled)
:selection-number 2 ;; :body ((when (and elgantt-org-id blocker-raw (not (string-empty-p blocker-raw)))
:selection-messages ((1 . "Select the BLOCKING task (Cause)") ;; ;; 1. GET DESTINATION (Start of current task)
(2 . "Select the BLOCKED task (Effect)")) ;; ;; We use the built-in elgantt-scheduled arg if available, it's faster and safer.
:execution-functions ;; (let* ((p-dest (save-excursion
((1 . ((elgantt-with-point-at-orig-entry nil (org-id-get-create)))) ;; (let ((d-start (or (when (stringp elgantt-scheduled) (substring elgantt-scheduled 0 10))
(2 . ((let* ((new-id return-val) ;; (elgantt-with-point-at-orig-entry nil
(current (elgantt-with-point-at-orig-entry nil (org-entry-get (point) "BLOCKER")))) ;; (save-excursion
(elgantt-with-point-at-orig-entry nil ;; (org-back-to-heading t)
(if (and current (string-match "ids(\\(.*?\\))" current)) ;; (when (re-search-forward "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" (line-end-position) t)
(let ((existing (match-string 1 current))) ;; (match-string 1)))))))
(org-set-property "BLOCKER" (format "ids(%s %s)" existing new-id))) ;; (when (and d-start (elgantt--goto-date d-start)) (point))))))
(org-set-property "BLOCKER" (format "ids(%s)" new-id)))
(message "Added blocker: %s" new-id)))))))
;; --- 5. Blocker Lines (Surgical Alignment Fix) --- ;; (when (numberp p-dest)
(elgantt-create-display-rule draw-blocker-lines ;; (let ((ids-string (if (string-match "ids(\\(.*?\\))" blocker-raw) (match-string 1 blocker-raw) blocker-raw))
:parser ((blocker-raw . ((org-entry-get (point) "BLOCKER")))) ;; (id-list (split-string (if (string-match "ids(\\(.*?\\))" blocker-raw) (match-string 1 blocker-raw) blocker-raw) "[ ,]+" t)))
:args (elgantt-org-id) ;; (dolist (blocker-id id-list)
:body ((when (and blocker-raw (not (string-empty-p blocker-raw))) ;; (save-excursion
(let* ((p-blocked (point)) ;; (when (elgantt--goto-id blocker-id)
(ids-string (if (string-match "ids(\\(.*?\\))" blocker-raw) ;; (let ((d-end-str nil)
(match-string 1 blocker-raw) ;; (row-start (line-beginning-position))
blocker-raw)) ;; (row-end (line-end-position)))
(id-list (split-string ids-string "[ ,]+" t))) ;; ;; 2. GET BLOCKER END DATE
(dolist (blocker-id id-list) ;; (elgantt-with-point-at-orig-entry nil
(save-excursion ;; (save-excursion
(when (elgantt--goto-id blocker-id) ;; (org-back-to-heading t)
(let* ((blocker-data (elgantt-with-point-at-orig-entry nil ;; (let ((limit (save-excursion (outline-next-heading) (point))))
(list (org-entry-get (point) "SCHEDULED") ;; (if (re-search-forward "<[^>]+>--<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" limit t)
(org-entry-get (point) "EFFORT") ;; (setq d-end-str (match-string 1))
(org-entry-get (point) "WEEKEND_DAYS")))) ;; (let ((s (org-entry-get (point) "SCHEDULED"))
(b-sched (nth 0 blocker-data)) ;; (e (org-entry-get (point) "EFFORT"))
(b-effort (nth 1 blocker-data)) ;; (w (string-to-number (or (org-entry-get (point) "WEEKEND_DAYS") "0"))))
(b-wknd (when (nth 2 blocker-data) (string-to-number (nth 2 blocker-data))))) ;; (when (and s e)
(when (and b-sched b-effort) ;; (setq d-end-str (ts-format "%Y-%m-%d" (ts-adjust 'day (1- (+ (ceiling (/ (float (org-duration-to-minutes e)) 1440.0)) w)) (ts-parse s))))))))))
(let* ((start-ts (ts-parse b-sched))
(raw-mins (org-duration-to-minutes b-effort))
;; Visual length must match the Effort Rule exactly
(total-days (+ (ceiling (/ (float raw-mins) 1440.0)) (or b-wknd 0)))
(p-start (save-excursion
(elgantt--goto-date (ts-format "%Y-%m-%d" start-ts))
(point))))
(when (and (numberp p-start) (numberp p-blocked))
;; Point to the LAST DAY of the task bar
(let* ((end-date-ts (ts-adjust 'day (max 0 (1- total-days)) start-ts))
(p-line-start (save-excursion
(elgantt--goto-date (ts-format "%Y-%m-%d" end-date-ts))
(point))))
(when (numberp p-line-start)
;; DRAW: From p-line-start to p-blocked
;; Note: Removed the (1+) to pull the line back by one day
(elgantt--draw-line (truncate p-line-start)
(truncate p-blocked)
"#b8bb26"))))))))))))))
;; --- 6. Hashtag Navigation --- ;; ;; 3. DRAW
(elgantt-create-action follow-hashtag-link-forward ;; (when d-end-str
:args (elgantt-alltags) :binding "C-M-f" ;; (save-excursion
:body ((when-let* ((hashtag (--first (s-starts-with-p "#" it) elgantt-alltags)) ;; (elgantt--goto-date d-end-str)
(match (elgantt--next-match :elgantt-alltags hashtag))) ;; (let ((p-source (point)))
(goto-char (car match))))) ;; (if (and (>= p-source row-start) (<= p-source row-end))
;; (elgantt--draw-line (truncate p-source) (truncate p-dest) "#b8bb26")
;; ;; Force to row if it jumped
;; (let ((col-offset (- p-source (save-excursion (goto-char p-source) (line-beginning-position)))))
;; (goto-char row-start)
;; (forward-char col-offset)
;; (elgantt--draw-line (point) (truncate p-dest) "#b8bb26")))))))))))))))
;; )
(elgantt-create-action follow-hashtag-link-backward ;; (defun elgantt-open-current-org-file ()
:args (elgantt-alltags) :binding "C-M-b" ;; (interactive)
:body ((when-let* ((hashtag (--first (s-starts-with-p "#" it) elgantt-alltags)) ;; (if-let ((file (buffer-file-name)))
(match (elgantt--previous-match :elgantt-alltags hashtag))) ;; (progn
(goto-char (car match))))) ;; (setq elgantt-agenda-files (list file))
) ;; (elgantt--reset-org-ql-cache)
;; (elgantt-open))
(defun elgantt-open-current-org-file () ;; (message "No file!")))
(interactive)
(if-let ((file (buffer-file-name)))
(progn
(setq elgantt-agenda-files (list file))
(elgantt--reset-org-ql-cache)
(elgantt-open))
(message "No file!")))
(setq org-roam-directory (file-truename "~/ExoKortex/") (setq org-roam-directory (file-truename "~/ExoKortex/")
org-roam-db-location (file-truename "~/ExoKortex/2-Areas/IT/Roam/org-roam.db") org-roam-db-location (file-truename "~/ExoKortex/2-Areas/IT/Roam/org-roam.db")
@@ -1559,7 +1550,7 @@ If FILE is nil, refile in the current file."
(add-hook 'ediff-prepare-buffer-hook 'org-ediff-prepare-buffer) (add-hook 'ediff-prepare-buffer-hook 'org-ediff-prepare-buffer)
;;; ============================================================ ;;; ============================================================
;;; GORTIUM — Org chain scheduler (timestamp-based, no duplicates) ;;; GORTIUM — Org chain scheduler (Safe & Optimized with Debugging)
;;; ============================================================ ;;; ============================================================
(require 'org) (require 'org)
@@ -1603,9 +1594,30 @@ If FILE is nil, refile in the current file."
(nthcdr 3 (decode-time next))))))) (nthcdr 3 (decode-time next)))))))
(t t1)))) (t t1))))
;; ------------------------------------------------------------ (defun gortium/org--get-range-start (pos)
;; Helper: Calculate task span using EFFORT (hour-grained) "Extract the start timestamp from an existing range like <A>--<B>.
;; ------------------------------------------------------------ Returns nil if no range found (safe, non-blocking)."
(save-excursion
(goto-char pos)
(org-back-to-heading t)
(let ((end (save-excursion
(or (ignore-errors (outline-next-heading))
(point-max))
(point)))
(start-time nil))
(save-restriction
(narrow-to-region (point) end)
(goto-char (point-min))
;; Look for range in first 50 lines only (safety limit)
(let ((search-limit (save-excursion
(forward-line 50)
(point))))
(when (re-search-forward "<\\([^>]+\\)>--<[^>]+>" search-limit t)
(condition-case nil
(setq start-time (org-time-string-to-time (match-string 1)))
(error nil)))))
start-time)))
(defun gortium/internal--calculate-task-span (start-time effort-str) (defun gortium/internal--calculate-task-span (start-time effort-str)
"Return a list (END-TIME WEEKEND-DAYS) for given START-TIME and EFFORT string." "Return a list (END-TIME WEEKEND-DAYS) for given START-TIME and EFFORT string."
(if (or (null effort-str) (string-empty-p effort-str)) (if (or (null effort-str) (string-empty-p effort-str))
@@ -1617,8 +1629,11 @@ If FILE is nil, refile in the current file."
(cursor start-time) (cursor start-time)
(wknd-count 0) (wknd-count 0)
(day-start 8) (day-start 8)
(day-end 16)) (day-end 16)
(while (> total-work-mins 0) (safety-counter 0)
(max-iterations 1000)) ;; Safety limit
(while (and (> total-work-mins 0) (< safety-counter max-iterations))
(setq safety-counter (1+ safety-counter))
(let* ((decoded (decode-time cursor)) (let* ((decoded (decode-time cursor))
(h (nth 2 decoded)) (h (nth 2 decoded))
(m (nth 1 decoded)) (m (nth 1 decoded))
@@ -1642,183 +1657,242 @@ If FILE is nil, refile in the current file."
(t ;; spill to next day (t ;; spill to next day
(setq total-work-mins (- total-work-mins mins-left-today)) (setq total-work-mins (- total-work-mins mins-left-today))
(setq cursor (time-add cursor (seconds-to-time (* mins-left-today 60)))))))) (setq cursor (time-add cursor (seconds-to-time (* mins-left-today 60))))))))
(when (>= safety-counter max-iterations)
(message "WARNING: calculate-task-span hit iteration limit for effort %s" effort-str))
(list cursor wknd-count)))) (list cursor wknd-count))))
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
;; Helper: Find dependency end time ;; Helper: Find dependency end time
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
(defun gortium/internal--get-blocker-end (blocker-str current-pos task-end-map) (defun gortium/internal--get-blocker-end (blocker-str task-end-map)
"Return the latest end time among the dependencies listed in BLOCKER-STR." "Return latest end time only if blockers are DONE or have been recalculated."
(let ((clean (s-trim (format "%s" blocker-str))) (let ((clean (s-trim (format "%s" blocker-str)))
(latest-time nil)) (latest-time nil)
(cond (all-resolved t))
((string-match-p "previous-sibling" clean) (when (and (string-match "ids(\\(.*?\\))" clean)
(save-excursion (not (string-empty-p (s-trim (match-string 1 clean)))))
(goto-char current-pos)
(let ((found nil))
(while (and (not found) (org-get-last-sibling))
(let* ((sid (org-id-get))
(end (when sid (gethash sid task-end-map))))
(when end
(setq latest-time end
found t)))))))
((string-match-p "parent" clean)
(save-excursion
(goto-char current-pos)
(when (org-up-heading-safe)
(setq latest-time (gethash (org-id-get) task-end-map)))))
((string-match "ids(\\(.*?\\))" clean)
(dolist (tid (split-string (match-string 1 clean) "[ ,]+" t)) (dolist (tid (split-string (match-string 1 clean) "[ ,]+" t))
(let ((tend (gethash (replace-regexp-in-string "[\"']\\|id:" "" tid) task-end-map))) (let* ((clean-id (replace-regexp-in-string "[\"']\\|id:" "" tid))
(when (and tend (pos (org-id-find clean-id t))
(or (null latest-time) (computed-end (gethash clean-id task-end-map))
(time-less-p latest-time tend))) (blocker-end
(setq latest-time tend)))))) (cond
latest-time)) ;; 1) Use the new time we just calculated in this run (Priority!)
(computed-end computed-end)
;; ------------------------------------------------------------ ;; 2) If it's DONE, use the CLOSED timestamp
;; Helper: Get earliest timestamp in entry ((and pos (org-entry-get pos "CLOSED"))
;; ------------------------------------------------------------ (org-time-string-to-time (org-entry-get pos "CLOSED")))
(defun gortium/org--get-anchor-time ()
"Return the earliest timestamp in current entry, or nil."
(save-excursion
(org-back-to-heading t)
(let ((limit (save-excursion (outline-next-heading) (point)))
(best nil))
(while (re-search-forward org-ts-regexp-both limit t 1)
(let ((ts (org-time-string-to-time (match-string 0))))
(when (or (null best) (time-less-p ts best))
(setq best ts))))
best)))
;; ------------------------------------------------------------ ;; 3) If it's FIXED, use the existing range/scheduled time
;; Helper: Write timestamp range (NO SCHEDULED) ((and pos (string-equal "t" (org-entry-get pos "FIXED")))
;; ------------------------------------------------------------ (or (gortium/org--get-range-start pos) ;; Note: This needs range end logic, but start is a fallback
(defun gortium/internal--update-properties (pos start wknd id end task-end-map &optional fixed original-start) (org-get-scheduled-time pos)))
"Update WEEKEND_DAYS and write the time range at POS.
For fixed tasks, ORIGINAL-START is preserved. OLD SCHEDULED/range lines are removed. ;; Otherwise: We MUST wait for this blocker to be recalculated
The range is inserted directly below the heading, before any drawers." (t nil))))
(if blocker-end
(setq latest-time (if (or (null latest-time) (time-less-p latest-time blocker-end))
blocker-end latest-time))
(setq all-resolved nil)))))
(when all-resolved latest-time)))
(defun gortium/internal--update-properties (pos start wknd id end task-end-map)
"Heals the property drawer, updates values, and fixes vertical spacing without leaking newlines."
(message "[DEBUG] enter update-properties for %s" id)
(save-excursion (save-excursion
(goto-char pos) (goto-char pos)
(org-show-entry)
;; Update WEEKEND_DAYS property
(if (and wknd (> wknd 0))
(org-entry-put (point) "WEEKEND_DAYS" (number-to-string wknd))
(org-entry-delete (point) "WEEKEND_DAYS"))
;; Remove old ranges or SCHEDULED lines
(save-excursion
(org-back-to-heading t) (org-back-to-heading t)
(let ((limit (save-excursion (outline-next-heading) (point)))) (let* ((subtree-start (point))
(forward-line 1) (subtree-end (save-excursion (org-end-of-subtree t) (point))))
(while (< (point) limit)
(cond
((looking-at "^[ \t]*SCHEDULED:") (delete-region (point-at-bol) (1+ (point-at-eol))))
((looking-at "^[ \t]*<.*>--<.*>") (delete-region (point-at-bol) (1+ (point-at-eol))))
((looking-at "^\\*+") (goto-char limit))
((looking-at "^[ \t]*:") (goto-char (line-beginning-position))
(setq limit (point)))
(t (forward-line 1))))))
;; Determine insertion point: after heading, before drawers (save-restriction
(let ((insert-point (save-excursion (narrow-to-region subtree-start subtree-end)
(org-back-to-heading t)
(forward-line 1)
(point)))
(range-start (if fixed original-start start))) ;; preserve start if fixed
;; Insert range
(goto-char insert-point)
(insert (format "%s--%s"
(format-time-string "<%Y-%m-%d %a %H:%M>" range-start)
(format-time-string "<%Y-%m-%d %a %H:%M>" end))
"\n"))
;; Update task-end-map ;; --- STEP 1: HEAL THE DRAWER ---
(goto-char (point-min))
(forward-line 1)
(while (looking-at "^[ \t]*\\(CLOSED:\\|SCHEDULED:\\|DEADLINE:\\)")
(forward-line 1))
(when (looking-at "^[ \t]*:PROPERTIES:[ \t]*$")
(let ((drawer-start (point)))
(when (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)
(let ((drawer-end (match-end 0)))
(save-restriction
(narrow-to-region drawer-start drawer-end)
(goto-char (point-min))
(forward-line 1)
(while (re-search-forward "^[ \t]*$" nil t)
(delete-region (line-beginning-position)
(min (1+ (line-end-position)) (point-max)))))))))
;; --- STEP 2: UPDATE PROPERTY ---
(org-entry-put nil "WEEKEND_DAYS" (number-to-string (or wknd 0)))
;; --- STEP 3: REMOVE OLD RANGE ---
(goto-char (point-min))
(while (re-search-forward "^[ \t]*<.+>--<.+>[ \t]*\n?" nil t)
(replace-match ""))
;; --- STEP 4: FIND INSERTION POINT ---
(goto-char (point-min))
(forward-line 1)
(while (looking-at "^[ \t]*\\(CLOSED:\\|SCHEDULED:\\|DEADLINE:\\)")
(forward-line 1))
(while (looking-at "^[ \t]*:\\([A-Z_]+\\):[ \t]*$")
(when (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)
(forward-line 1)))
;; Delete any existing blank lines at the insertion point
(while (and (looking-at "^[ \t]*$") (not (eobp)))
(delete-region (line-beginning-position) (line-beginning-position 2)))
;; --- STEP 5: INSERT RANGE ---
;; Ensure range starts on a new line and ends with exactly one newline
(unless (bolp) (insert "\n"))
(insert (format "<%s>--<%s>\n"
(format-time-string "%Y-%m-%d %a %H:%M" start)
(format-time-string "%Y-%m-%d %a %H:%M" end)))
;; --- STEP 6: CLEAN UP REMAINING WHITESPACE WITHIN TASK ---
(while (and (looking-at "^[ \t]*$") (not (eobp)))
(delete-region (line-beginning-position) (line-beginning-position 2))))
;; --- STEP 7: NORMALIZE SPACING BETWEEN TASKS ---
;; Instead of inserting a newline blindly, we ensure exactly one blank line
;; exists between this subtree's end and the next heading.
(goto-char (org-end-of-subtree t))
(let ((post-subtree (point)))
(save-restriction
(widen)
(goto-char post-subtree)
(delete-blank-lines)
;; Only insert a blank line if we aren't at the end of the buffer
(unless (eobp)
(insert "\n")))))
(message "[DEBUG] exit update-properties")
(puthash id end task-end-map))) (puthash id end task-end-map)))
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
;; MAIN FUNCTION ;; Helper: Detect circular dependencies
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
(defun gortium/internal--detect-circular-deps (tasks)
"Check for circular dependencies in TASKS.
Returns list of task IDs involved in cycles, or nil if no cycles found."
(let ((graph (make-hash-table :test 'equal))
(visiting (make-hash-table :test 'equal))
(visited (make-hash-table :test 'equal))
(cycles nil))
;; Build dependency graph
(dolist (task tasks)
(pcase-let ((`(,_pos ,id ,_effort ,blocker ,_fixed ,_sched ,_rng-start ,_offset ,_state) task))
(when (and blocker (not (string-empty-p (s-trim blocker))))
(when (string-match "ids(\\(.*?\\))" blocker)
(let ((deps (split-string (match-string 1 blocker) "[ ,]+" t)))
(puthash id (mapcar (lambda (tid)
(replace-regexp-in-string "[\"']\\|id:" "" tid))
deps)
graph))))))
;; DFS to detect cycles
(cl-labels ((dfs (node path)
(cond
((gethash node visiting)
;; Found a cycle
(push node cycles)
t)
((gethash node visited)
nil)
(t
(puthash node t visiting)
(dolist (dep (gethash node graph))
(when (dfs dep (cons node path))
(push node cycles)))
(remhash node visiting)
(puthash node t visited)
nil))))
(maphash (lambda (node _deps)
(unless (gethash node visited)
(dfs node nil)))
graph))
(delete-dups cycles)))
(advice-add 'org-roam-db-sync :before
(lambda (&rest _)
(message "[DEBUG] org-roam-db-sync invoked")))
;; --- MAIN SCHEDULER ---
(defun gortium/org-schedule-subtree-chains () (defun gortium/org-schedule-subtree-chains ()
"Optimized scheduler: Ignores stale buffer ranges to ensure correct dependency flow."
(interactive) (interactive)
(save-excursion (message "=== Starting Gortium Scheduler ===")
(message "--- Starting Global Gantt Scheduler ---")
(let ((all-tasks '()) ;; 1. Global deactivations to prevent the "Parser Error"
(let ((org-element-use-cache nil)
(all-tasks '())
(task-end-times (make-hash-table :test 'equal)) (task-end-times (make-hash-table :test 'equal))
(task-end-for-blockers (make-hash-table :test 'equal))) (start-time (current-time)))
;; COLLECTION
;; 2. COLLECTION
(org-map-entries (org-map-entries
(lambda () (lambda ()
(let ((state (org-get-todo-state))) (when (org-get-todo-state)
(when state
(let* ((pos (point-marker)) (let* ((pos (point-marker))
(id (org-id-get-create)) (id (or (org-id-get) (org-id-get-create))))
(effort (org-entry-get (point) "EFFORT")) (push (list (current-buffer) pos id
(blocker (org-entry-get (point) "BLOCKER")) (org-entry-get pos "EFFORT")
(fixed (org-entry-get (point) "FIXED")) (org-entry-get pos "BLOCKER")
(anchor (or (org-get-scheduled-time (point)) (org-entry-get pos "FIXED")
(gortium/org--get-anchor-time))) (org-get-scheduled-time pos)
(closed (org-entry-get (point) "CLOSED")) (org-entry-get pos "OFFSET_DAYS"))
(offset (org-entry-get (point) "OFFSET_DAYS"))) all-tasks))))
(when (or effort blocker fixed (string= state "DONE"))
(push (list pos id effort blocker fixed anchor offset state closed)
all-tasks))))))
nil nil) nil nil)
(setq all-tasks (nreverse all-tasks)) (setq all-tasks (nreverse all-tasks))
;; PASS 1: DONE & FIXED ;; 3. THE LOOP
(dolist (task all-tasks) (let* ((remaining all-tasks)
(pcase-let ((`(,pos ,id ,effort ,_ ,fixed ,anchor ,_ ,state ,closed) task)) (limit (* 20 (length remaining)))
(cond
;; DONE: compute range like normal, CLOSED is used for blockers
((string= state "DONE")
(let* ((start (or anchor (current-time)))
(span (gortium/internal--calculate-task-span start effort)))
(gortium/internal--update-properties pos (car span) (cadr span) id (car span)
task-end-times))
;; Store CLOSED for dependencies
(when closed
(puthash id (org-time-string-to-time closed) task-end-for-blockers)))
;; FIXED tasks
((and fixed anchor)
(let* ((span (gortium/internal--calculate-task-span anchor effort)))
(gortium/internal--update-properties pos anchor (cadr span) id (car span)
task-end-times)))
;; nothing else here
)))
;; PASS 2: CHAINS
(let ((remaining (cl-remove-if (lambda (t)
(gethash (nth 1 t) task-end-times))
all-tasks))
(limit (* 5 (length all-tasks)))
(iter 0)) (iter 0))
(while (and remaining (< iter limit))
(cl-incf iter)
(let ((done '()))
(dolist (task remaining)
(pcase-let ((`(,pos ,id ,effort ,blocker ,_ ,_ ,offset ,state ,closed) task))
;; Determine dependency end
(let* ((dep (or (gortium/internal--get-blocker-end blocker pos
task-end-times)
(and (string= state "DONE")
(gethash id task-end-for-blockers)))))
(when dep
(let* ((off (if offset (string-to-number offset) 0))
(start (gortium/internal--snap-to-working-hours
(time-add dep (days-to-time off))))
(span (gortium/internal--calculate-task-span start effort)))
;; FIXED tasks: keep start
(if (and (not (string= state "DONE")) (org-entry-get pos "FIXED"))
(gortium/internal--update-properties pos anchor (cadr span) id (car span)
task-end-times)
(gortium/internal--update-properties pos (car span) (cadr span) id (car span)
task-end-times))
(push task done))))))
(setq remaining (cl-set-difference remaining done)))))
(message "--- Scheduler Finished ---")))) (while (and remaining (< iter limit))
(setq iter (1+ iter))
(let ((done-this-loop '()))
(dolist (task remaining)
(pcase-let ((`(,buf ,pos ,id ,effort ,blocker ,fixed ,sched ,offset) task))
(let* ((blocker-end (gortium/internal--get-blocker-end blocker task-end-times))
(has-blocker (and blocker (not (string-empty-p (s-trim blocker)))))
;; A task is ready if it's FIXED or all blockers are in the task-end-times map
(is-fixed (string-equal fixed "t"))
(ready (or is-fixed (not has-blocker) blocker-end)))
(when ready
(with-current-buffer buf
(org-element-with-disabled-cache
(let* ((off-days (if (stringp offset) (string-to-number offset) 0))
(base-start (cond (is-fixed (or (gortium/org--get-range-start pos) sched (current-time)))
(t (or blocker-end sched (current-time)))))
(final-start (if is-fixed base-start
(gortium/internal--snap-to-working-hours (time-add base-start (days-to-time off-days)))))
(span (gortium/internal--calculate-task-span final-start effort))
(final-end (car span))
(wknd (cadr span)))
(gortium/internal--update-properties pos final-start wknd id final-end task-end-times)
(push task done-this-loop))))))))
(setq remaining (cl-set-difference remaining done-this-loop))))
(org-element-cache-reset 'all)
(message "=== Scheduler completed (%d tasks, %d iterations) ===" (length all-tasks) iter))))
;; --------------------------------------------- ;; ---------------------------------------------
(defun gortium/org-ensure-task-properties () (defun gortium/org-ensure-task-properties ()
@@ -1831,7 +1905,7 @@ and ensure the standard property drawer exists without overwriting existing data
;; List of properties to ensure exist ;; List of properties to ensure exist
(props '("EFFORT" "BLOCKER" "FIXED" "WEEKEND_DAYS" (props '("EFFORT" "BLOCKER" "FIXED" "WEEKEND_DAYS"
"ASSIGNEE" "RESOURCES" "CATEGORY" "ASSIGNEE" "RESOURCES" "CATEGORY"
"DIMENTIONS" "WEIGHT"))) "DIMENTIONS" "WEIGHT" "OFFSET_DAYS")))
(org-map-entries (org-map-entries
(lambda () (lambda ()
;; This check returns true if the heading has ANY todo keyword ;; This check returns true if the heading has ANY todo keyword