WIP range for task instead of scheduled + ranges
This is to fix the double entry in the agenda. One for the scheduled + one for the range. We want only the range. But right now the code duplicate Ranges and PROPERTIES drawer.
This commit is contained in:
@@ -280,7 +280,7 @@ change ~org-directory~. It must be set before org loads!
|
||||
|
||||
(setq org-global-properties
|
||||
'(("Effort_ALL" . "0:10 0:30 1:00 2:00 4:00 8:00")
|
||||
("ASSIGNEE_ALL" . "Thierry.P Cath.F Martin.K Michel.B Gabriel.C Silvie.L George.G Miguel.A Réjean.S Dominique Adnane Helper1 Helper2")))
|
||||
("ASSIGNEE_ALL" . "Thierry.P Cath.F Martin.K Michel.B Gabriel.C Silvie.L George.G Miguel.A Réjean.S Dominique Adnane Hatim.K Marc-Antoine.P")))
|
||||
|
||||
(setq org-stuck-projects
|
||||
'("TODO=\"PROJ\"" ("NEXT") nil ""))
|
||||
@@ -466,9 +466,11 @@ change ~org-directory~. It must be set before org loads!
|
||||
)
|
||||
("wP" "THE PLAN"
|
||||
((agenda ""
|
||||
((org-agenda-span 'month)
|
||||
((org-agenda-span 60)
|
||||
(org-agenda-start-day nil)
|
||||
(org-agenda-overriding-header "📅 THE PLAN"))
|
||||
(org-agenda-overriding-header "📅 THE PLAN")
|
||||
(org-agenda-prefix-format " %?-12t%-12s")
|
||||
)
|
||||
)
|
||||
)
|
||||
((org-agenda-tag-filter-preset '("+work")))
|
||||
@@ -499,6 +501,9 @@ change ~org-directory~. It must be set before org loads!
|
||||
:matchers ("begin" "$1" "$" "$$" "\\(" "\\["))
|
||||
)
|
||||
)
|
||||
|
||||
(after! ox-latex
|
||||
(setq org-latex-compiler "xelatex"))
|
||||
#+end_src
|
||||
|
||||
** Org Capture
|
||||
@@ -573,8 +578,18 @@ fc --> UC3
|
||||
(setq elgantt--display-rules nil)
|
||||
|
||||
(defface gortium/elgantt-weekend-face
|
||||
'((t (:background "#332222" :extend nil)))
|
||||
"Face for weekend vertical columns in ElGantt.")
|
||||
'((t (:background "#32302f" :extend nil)))
|
||||
"Gruvbox Dark0_Hard/Soft mix for subtle weekend stripes.")
|
||||
|
||||
(defun gortium/internal--month-to-num (name)
|
||||
"Convert month string to number safely."
|
||||
(let ((case-fold-search t))
|
||||
(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 "May" name) 5) ((string-match-p "Jun" name) 6)
|
||||
((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 "Nov" name) 11) ((string-match-p "Dec" name) 12) (t 1))))
|
||||
|
||||
(defun gortium/elgantt-draw-weekend-guides ()
|
||||
"Draw weekend guides for the ENTIRE buffer once to prevent scroll lag."
|
||||
@@ -646,7 +661,7 @@ fc --> UC3
|
||||
(setq elgantt-start-date "2026-01-01")
|
||||
|
||||
(setq elgantt-header-column-offset 40
|
||||
elgantt-header-type 'outline
|
||||
elgantt-header-type 'root
|
||||
elgantt-show-header-depth t
|
||||
elgantt-insert-blank-line-between-top-level-header t
|
||||
elgantt-startup-folded nil
|
||||
@@ -723,7 +738,7 @@ fc --> UC3
|
||||
(org-set-property "BLOCKER" (format "ids(%s)" new-id)))
|
||||
(message "Added blocker: %s" new-id)))))))
|
||||
|
||||
;; --- 5. Blocker Lines (Multi-ID & Sync Support) ---
|
||||
;; --- 5. Blocker Lines (Surgical Alignment Fix) ---
|
||||
(elgantt-create-display-rule draw-blocker-lines
|
||||
:parser ((blocker-raw . ((org-entry-get (point) "BLOCKER"))))
|
||||
:args (elgantt-org-id)
|
||||
@@ -732,31 +747,34 @@ fc --> UC3
|
||||
(ids-string (if (string-match "ids(\\(.*?\\))" blocker-raw)
|
||||
(match-string 1 blocker-raw)
|
||||
blocker-raw))
|
||||
;; Supports spaces or commas as separators
|
||||
(id-list (split-string ids-string "[ ,]+" t)))
|
||||
(dolist (blocker-id id-list)
|
||||
(save-excursion
|
||||
(when (elgantt--goto-id blocker-id)
|
||||
(let* ((blocker-data (elgantt-with-point-at-orig-entry nil
|
||||
(list (org-entry-get (point) "SCHEDULED")
|
||||
(org-entry-get (point) "EFFORT"))))
|
||||
(b-sched (car blocker-data))
|
||||
(b-effort (cadr blocker-data)))
|
||||
(org-entry-get (point) "EFFORT")
|
||||
(org-entry-get (point) "WEEKEND_DAYS"))))
|
||||
(b-sched (nth 0 blocker-data))
|
||||
(b-effort (nth 1 blocker-data))
|
||||
(b-wknd (when (nth 2 blocker-data) (string-to-number (nth 2 blocker-data)))))
|
||||
(when (and b-sched b-effort)
|
||||
(let* ((start-ts (ts-parse b-sched))
|
||||
(raw-mins (org-duration-to-minutes b-effort))
|
||||
(days-count (ceiling (/ (float raw-mins) 1440.0)))
|
||||
(p-start-base (save-excursion
|
||||
(elgantt--goto-date (ts-format "%Y-%m-%d" start-ts))
|
||||
(point))))
|
||||
(when (and (numberp p-start-base) (numberp p-blocked))
|
||||
;; FIX 1: compute p-line-start by date (handles "|" separators)
|
||||
;; FIX 2: keep original "Rule of 2" behavior to avoid +1 day overshoot
|
||||
(let* ((end-ts (ts-adjust 'day (- days-count 2) start-ts))
|
||||
;; 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-ts))
|
||||
(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"))))))))))))))
|
||||
@@ -786,7 +804,7 @@ fc --> UC3
|
||||
#+end_src
|
||||
|
||||
#+RESULTS:
|
||||
: elgantt--action-rule-follow-hashtag-link-backward
|
||||
: elgantt-open-current-org-file
|
||||
|
||||
* Org Roam
|
||||
|
||||
@@ -2191,241 +2209,311 @@ If FILE is nil, refile in the current file."
|
||||
* Custom function for reschedulling
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defun gortium/add-trigger-scheduling-next ()
|
||||
"Add scheduled chain for this entry."
|
||||
(interactive)
|
||||
(org-set-property "TRIGGER" "next-sibling scheduled!(\"++0d\") todo!(NEXT) chain!(\"TRIGGER\")"))
|
||||
;;; ============================================================
|
||||
;;; GORTIUM — Org chain scheduler (timestamp-based, no duplicates)
|
||||
;;; ============================================================
|
||||
|
||||
(defun gortium/org-schedule-after-previous-sibling ()
|
||||
"Schedule the current task right after its previous sibling.
|
||||
If the sibling is DONE, use its CLOSED time.
|
||||
Otherwise, use SCHEDULED + EFFORT."
|
||||
(interactive)
|
||||
(unless (org-at-heading-p)
|
||||
(org-back-to-heading t))
|
||||
(let ((current-level (org-current-level))
|
||||
(current-point (point))
|
||||
prev-end-time)
|
||||
(save-excursion
|
||||
;; Find previous sibling of same level
|
||||
(let ((found nil))
|
||||
(while (and (not found) (outline-previous-heading))
|
||||
(when (= (org-current-level) current-level)
|
||||
(setq found t)))
|
||||
(unless found
|
||||
(user-error "No previous sibling found"))
|
||||
;; At previous sibling now
|
||||
(let* ((state (org-get-todo-state))
|
||||
(scheduled (org-entry-get nil "SCHEDULED"))
|
||||
(closed (org-entry-get nil "CLOSED"))
|
||||
(effort (org-entry-get nil "EFFORT")))
|
||||
(cond
|
||||
;; If task is DONE and CLOSED exists
|
||||
((and (member state org-done-keywords) closed)
|
||||
(setq prev-end-time (org-time-string-to-time closed)))
|
||||
;; Else use SCHEDULED + EFFORT
|
||||
((and scheduled effort)
|
||||
(let* ((sched-time (org-time-string-to-time scheduled))
|
||||
(duration-min (org-duration-to-minutes effort)))
|
||||
(setq prev-end-time
|
||||
(time-add sched-time (seconds-to-time (* 60 duration-min))))))
|
||||
(t
|
||||
(user-error "Previous sibling missing SCHEDULED/CLOSED or EFFORT"))))))
|
||||
;; Schedule current task
|
||||
(goto-char current-point)
|
||||
(org-schedule nil (format-time-string (org-time-stamp-format t) prev-end-time))))
|
||||
(require 'org)
|
||||
(require 'org-id)
|
||||
(require 'cl-lib)
|
||||
(require 's)
|
||||
|
||||
;; --- Helper: Snap to working hours (8-16) ---
|
||||
;; --- Helper: Snap to working hours (8-16) ---
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Skip weekends (snap to next weekday at 08:00)
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/org--skip-weekend (time)
|
||||
(let* ((decoded (decode-time time))
|
||||
(dow (nth 6 decoded)))
|
||||
(cond
|
||||
((= dow 6) ;; Saturday
|
||||
(apply #'encode-time
|
||||
(append '(0 0 8)
|
||||
(nthcdr 3 (decode-time (time-add time (days-to-time 2)))))))
|
||||
((= dow 0) ;; Sunday
|
||||
(apply #'encode-time
|
||||
(append '(0 0 8)
|
||||
(nthcdr 3 (decode-time (time-add time (days-to-time 1)))))))
|
||||
(t time))))
|
||||
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Snap to working hours (08:00–16:00)
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/internal--snap-to-working-hours (time)
|
||||
(let* ((day-start 8) (day-end 16)
|
||||
(let* ((day-start 8)
|
||||
(day-end 16)
|
||||
(t1 (gortium/org--skip-weekend time))
|
||||
(d (decode-time t1)) (h (nth 2 d)))
|
||||
(cond
|
||||
((< h day-start) (apply #'encode-time (append (list 0 0 day-start) (nthcdr 3 d))))
|
||||
(d (decode-time t1))
|
||||
(h (nth 2 d)))
|
||||
(cond
|
||||
((< h day-start)
|
||||
(apply #'encode-time (append (list 0 0 day-start) (nthcdr 3 d))))
|
||||
((>= h day-end)
|
||||
(let ((next (time-add t1 (days-to-time 1))))
|
||||
(gortium/org--skip-weekend (apply #'encode-time (append (list 0 0 day-start) (nthcdr 3 (decode-time next)))))))
|
||||
(gortium/org--skip-weekend
|
||||
(apply #'encode-time (append (list 0 0 day-start)
|
||||
(nthcdr 3 (decode-time next)))))))
|
||||
(t t1))))
|
||||
|
||||
;; --- Helper: Calculate End Time & Weekend Jump (THE WALKER FIX) ---
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Calculate task span using EFFORT (hour-grained)
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/internal--calculate-task-span (start-time effort-str)
|
||||
"Return a list (END-TIME WEEKEND-DAYS) for given START-TIME and EFFORT string."
|
||||
(if (or (null effort-str) (string-empty-p effort-str))
|
||||
(list start-time 0)
|
||||
(let* ((eff-mins (org-duration-to-minutes effort-str))
|
||||
;; SMART MATH: If string has "d", divide by 1440 (24h). If only "h", divide by 480 (8h).
|
||||
(divisor (if (string-match-p "d" effort-str) 1440.0 480.0))
|
||||
(eff-days (max 1 (ceiling (/ (float eff-mins) divisor))))
|
||||
(total-work-mins (if (string-match-p "d" effort-str)
|
||||
(* (/ eff-mins 1440.0) 480)
|
||||
eff-mins))
|
||||
(cursor start-time)
|
||||
(days-worked 0)
|
||||
(wknd-count 0))
|
||||
|
||||
;; THE WALKER: Simulate the task day by day
|
||||
(while (< days-worked eff-days)
|
||||
(let* ((dow (nth 6 (decode-time cursor))))
|
||||
(wknd-count 0)
|
||||
(day-start 8)
|
||||
(day-end 16))
|
||||
(while (> total-work-mins 0)
|
||||
(let* ((decoded (decode-time cursor))
|
||||
(h (nth 2 decoded))
|
||||
(m (nth 1 decoded))
|
||||
(dow (nth 6 decoded))
|
||||
(current-abs-min (+ (* h 60) m))
|
||||
(day-end-abs-min (* day-end 60))
|
||||
(mins-left-today (- day-end-abs-min current-abs-min)))
|
||||
(cond
|
||||
;; If Sat (6) or Sun (0), it's a weekend. Count it, but don't advance work.
|
||||
((or (= dow 6) (= dow 0))
|
||||
((or (= dow 6) (= dow 0)) ;; weekend
|
||||
(setq wknd-count (1+ wknd-count))
|
||||
(setq cursor (time-add cursor (days-to-time 1))))
|
||||
;; If Mon-Fri, it's a work day. Advance work count.
|
||||
(t
|
||||
(setq days-worked (1+ days-worked))
|
||||
;; Move cursor to start of next day
|
||||
(setq cursor (time-add cursor (days-to-time 1)))))))
|
||||
|
||||
;; Return [End-Time, Weekend-Days-Count]
|
||||
(setq cursor (apply #'encode-time (append (list 0 0 day-start)
|
||||
(nthcdr 3 (decode-time
|
||||
(time-add cursor (days-to-time 1))))))))
|
||||
((<= mins-left-today 0) ;; after hours
|
||||
(setq cursor (apply #'encode-time (append (list 0 0 day-start)
|
||||
(nthcdr 3 (decode-time
|
||||
(time-add cursor (days-to-time 1))))))))
|
||||
((<= total-work-mins mins-left-today)
|
||||
(setq cursor (time-add cursor (seconds-to-time (* total-work-mins 60))))
|
||||
(setq total-work-mins 0))
|
||||
(t ;; spill to next day
|
||||
(setq total-work-mins (- total-work-mins mins-left-today))
|
||||
(setq cursor (time-add cursor (seconds-to-time (* mins-left-today 60))))))))
|
||||
(list cursor wknd-count))))
|
||||
|
||||
;; --- Helper: Find Blocker End Time ---
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Find dependency end time
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/internal--get-blocker-end (blocker-str current-pos task-end-map)
|
||||
(let ((clean (s-trim blocker-str)) (latest-time nil))
|
||||
"Return the latest end time among the dependencies listed in BLOCKER-STR."
|
||||
(let ((clean (s-trim (format "%s" blocker-str)))
|
||||
(latest-time nil))
|
||||
(cond
|
||||
((string-match-p "previous-sibling" clean)
|
||||
(save-excursion
|
||||
(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) (setq found t)))))))
|
||||
(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)
|
||||
(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))
|
||||
(let ((tend (gethash (replace-regexp-in-string "[\"']\\|id:" "" tid) task-end-map)))
|
||||
(when (and tend (or (null latest-time) (time-less-p latest-time tend)))
|
||||
(when (and tend
|
||||
(or (null latest-time)
|
||||
(time-less-p latest-time tend)))
|
||||
(setq latest-time tend))))))
|
||||
latest-time))
|
||||
|
||||
;; --- Helper: Write Properties (Safe) ---
|
||||
(defun gortium/internal--update-properties (pos start wknd id end task-end-map)
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Get earliest timestamp in entry
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/org--get-anchor-time ()
|
||||
"Return the earliest timestamp in current entry, or nil."
|
||||
(save-excursion
|
||||
(goto-char pos) ;; POS is a MARKER
|
||||
(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)))
|
||||
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Write timestamp range (NO SCHEDULED)
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/internal--update-properties (pos start wknd id end task-end-map &optional fixed original-start)
|
||||
"Update WEEKEND_DAYS and write the time range at POS.
|
||||
For fixed tasks, ORIGINAL-START is preserved. OLD SCHEDULED/range lines are removed.
|
||||
The range is inserted directly below the heading, before any drawers."
|
||||
(save-excursion
|
||||
(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-put (point) "WEEKEND_DAYS" nil))
|
||||
(org-schedule nil (format-time-string "<%Y-%m-%d %a %H:%M>" start))
|
||||
(puthash id end task-end-map)))
|
||||
(org-entry-delete (point) "WEEKEND_DAYS"))
|
||||
|
||||
(defun gortium/org--skip-weekend (time)
|
||||
"Advance TIME to the next Monday morning if it falls on a weekend."
|
||||
(let* ((decoded (decode-time time))
|
||||
(dow (nth 6 decoded)))
|
||||
(cond
|
||||
((= dow 6) ;; Saturday
|
||||
(let ((next (time-add time (days-to-time 2))))
|
||||
(apply #'encode-time (append '(0 0 8) (nthcdr 3 (decode-time next))))))
|
||||
((= dow 0) ;; Sunday
|
||||
(let ((next (time-add time (days-to-time 1))))
|
||||
(apply #'encode-time (append '(0 0 8) (nthcdr 3 (decode-time next))))))
|
||||
(t time))))
|
||||
|
||||
;; --- MAIN FUNCTION ---
|
||||
(defun gortium/org-schedule-subtree-chains ()
|
||||
"Schedule tasks using MARKERS and WALKER logic."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(message "--- Starting Gantt Scheduler ---")
|
||||
(let* ((all-tasks '()) (task-end-times (make-hash-table :test 'equal)))
|
||||
|
||||
;; Collection
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
(when (org-get-todo-state) ;; Strict TODO check
|
||||
(let ((effort (org-entry-get (point) "EFFORT" nil))
|
||||
(blocker (org-entry-get (point) "BLOCKER" nil))
|
||||
(fixed (org-entry-get (point) "FIXED" nil))
|
||||
(scheduled (org-entry-get (point) "SCHEDULED")))
|
||||
(when (or effort blocker fixed)
|
||||
(push (list (point-marker) (org-id-get-create) (org-get-heading t t t t)
|
||||
effort (when blocker (s-trim blocker)) fixed scheduled
|
||||
(org-entry-get (point) "OFFSET_DAYS" nil)) all-tasks)))))
|
||||
nil (if (org-at-heading-p) 'tree nil))
|
||||
(setq all-tasks (nreverse all-tasks))
|
||||
|
||||
;; Pass 1: FIXED
|
||||
(dolist (task all-tasks)
|
||||
(pcase-let ((`(,pos ,id ,heading ,effort ,blocker ,fixed ,scheduled ,offset) task))
|
||||
(when (and fixed (member (downcase fixed) '("t" "true" "yes")))
|
||||
(if scheduled
|
||||
(let* ((start (org-time-string-to-time scheduled))
|
||||
(span (gortium/internal--calculate-task-span start effort)))
|
||||
(save-excursion
|
||||
(goto-char pos)
|
||||
(if (and (cadr span) (> (cadr span) 0))
|
||||
(org-entry-put (point) "WEEKEND_DAYS" (number-to-string (cadr span)))
|
||||
(org-entry-put (point) "WEEKEND_DAYS" nil))
|
||||
(puthash id (car span) task-end-times)))
|
||||
(message "WARNING: Fixed task '%s' missing date." heading)))))
|
||||
|
||||
;; Pass 2: CHAINS
|
||||
(let* ((remaining (cl-remove-if (lambda (tk) (or (nth 5 tk) (not (nth 4 tk)))) all-tasks))
|
||||
(iter 0) (limit (* 5 (length all-tasks))))
|
||||
(while (and remaining (< iter limit))
|
||||
(cl-incf iter)
|
||||
(let ((scheduled-this-loop '()))
|
||||
(dolist (task remaining)
|
||||
(pcase-let ((`(,pos ,id ,heading ,effort ,blocker ,fixed ,scheduled ,offset) task))
|
||||
(let ((dep-end (gortium/internal--get-blocker-end blocker pos task-end-times)))
|
||||
(when dep-end
|
||||
(let* ((off-val (if offset (string-to-number offset) 0))
|
||||
(base-start (time-add dep-end (days-to-time off-val)))
|
||||
(start (gortium/internal--snap-to-working-hours base-start))
|
||||
(span (gortium/internal--calculate-task-span start effort)))
|
||||
(gortium/internal--update-properties pos start (cadr span) id (car span) task-end-times)
|
||||
(push task scheduled-this-loop))))))
|
||||
(setq remaining (cl-remove-if (lambda (tk) (member tk scheduled-this-loop)) remaining))))
|
||||
|
||||
(dolist (task all-tasks) (set-marker (car task) nil)) ;; Clean markers
|
||||
(message "--- Scheduler Finished ---")))))
|
||||
|
||||
;; USAGE:
|
||||
;; 1. Set up your tasks with either:
|
||||
;; - :FIXED: t and a SCHEDULED date, OR
|
||||
;; - :BLOCKER: previous-sibling / ids(UUID) / ids("id:UUID") / parent
|
||||
;; 2. Put cursor on "Planning" heading
|
||||
;; 3. M-x gortium/org-schedule-subtree-chains
|
||||
;;
|
||||
;; The function will:
|
||||
;; - Use FIXED tasks as anchors
|
||||
;; - Calculate all other tasks from their dependencies
|
||||
;; - Warn about tasks without BLOCKER or FIXED
|
||||
;; - Detect circular dependencies
|
||||
;; - Respect 8-hour workday limits
|
||||
;; - Skip weekends
|
||||
;;
|
||||
;; Supported BLOCKER types (standard EDNA format):
|
||||
;; - previous-sibling
|
||||
;; - ids(UUID) - e.g., ids(70d8f844-1952-43f0-8043-da51e8c8bc69)
|
||||
;; - ids("id:UUID") - e.g., ids("id:70d8f844-1952-43f0-8043-da51e8c8bc69")
|
||||
;; - parent
|
||||
|
||||
(defun gortium/add-ids-to-subtree ()
|
||||
"Add IDs to all headings in current subtree."
|
||||
(interactive)
|
||||
;; Remove old ranges or SCHEDULED lines
|
||||
(save-excursion
|
||||
(org-back-to-heading t)
|
||||
(org-map-entries
|
||||
(lambda () (org-id-get-create))
|
||||
nil 'tree)))
|
||||
(let ((limit (save-excursion (outline-next-heading) (point))))
|
||||
(forward-line 1)
|
||||
(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))))))
|
||||
|
||||
;; Custom function to shift projects
|
||||
(defun gortium/org-shift-subtree-schedules (days)
|
||||
"Shift all SCHEDULED dates in the current subtree by DAYS."
|
||||
(interactive "nDays to shift: ")
|
||||
;; Determine insertion point: after heading, before drawers
|
||||
(let ((insert-point (save-excursion
|
||||
(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
|
||||
(puthash id end task-end-map)))
|
||||
|
||||
;; ------------------------------------------------------------
|
||||
;; MAIN FUNCTION
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/org-schedule-subtree-chains ()
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(message "--- Starting Global Gantt Scheduler ---")
|
||||
(let ((all-tasks '())
|
||||
(task-end-times (make-hash-table :test 'equal))
|
||||
(task-end-for-blockers (make-hash-table :test 'equal)))
|
||||
;; COLLECTION
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
(let ((state (org-get-todo-state)))
|
||||
(when state
|
||||
(let* ((pos (point-marker))
|
||||
(id (org-id-get-create))
|
||||
(effort (org-entry-get (point) "EFFORT"))
|
||||
(blocker (org-entry-get (point) "BLOCKER"))
|
||||
(fixed (org-entry-get (point) "FIXED"))
|
||||
(anchor (or (org-get-scheduled-time (point))
|
||||
(gortium/org--get-anchor-time)))
|
||||
(closed (org-entry-get (point) "CLOSED"))
|
||||
(offset (org-entry-get (point) "OFFSET_DAYS")))
|
||||
(when (or effort blocker fixed (string= state "DONE"))
|
||||
(push (list pos id effort blocker fixed anchor offset state closed)
|
||||
all-tasks))))))
|
||||
nil nil)
|
||||
(setq all-tasks (nreverse all-tasks))
|
||||
|
||||
;; PASS 1: DONE & FIXED
|
||||
(dolist (task all-tasks)
|
||||
(pcase-let ((`(,pos ,id ,effort ,_ ,fixed ,anchor ,_ ,state ,closed) task))
|
||||
(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))
|
||||
(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 ---"))))
|
||||
|
||||
;; ---------------------------------------------
|
||||
(defun gortium/org-ensure-task-properties ()
|
||||
"Iterate through all tasks (TODO, NEXT, STRT, WAIT, HOLD, DONE, etc.)
|
||||
and ensure the standard property drawer exists without overwriting existing data."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(message "--- Initializing Task Properties for all states ---")
|
||||
(let ((count 0)
|
||||
;; List of properties to ensure exist
|
||||
(props '("EFFORT" "BLOCKER" "FIXED" "WEEKEND_DAYS"
|
||||
"ASSIGNEE" "RESOURCES" "CATEGORY"
|
||||
"DIMENTIONS" "WEIGHT")))
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
;; This check returns true if the heading has ANY todo keyword
|
||||
(let ((todo-state (org-get-todo-state)))
|
||||
(when todo-state
|
||||
(cl-incf count)
|
||||
;; 1. Handle ID (builtin handles 'do not replace' logic)
|
||||
(org-id-get-create)
|
||||
|
||||
;; 2. Ensure all other keys exist
|
||||
(dolist (prop props)
|
||||
;; Only add the property if it's currently nil/missing
|
||||
(unless (org-entry-get (point) prop)
|
||||
(org-entry-put (point) prop
|
||||
(if (string= prop "FIXED") "nil" "")))))))
|
||||
nil nil)
|
||||
(message "--- Finished: Processed %d tasks across all states ---" count))))
|
||||
|
||||
(defun gortium/add-ids-to-subtree ()
|
||||
"Add IDs to all headings in current subtree."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(org-back-to-heading t)
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
(let ((scheduled (org-entry-get nil "SCHEDULED")))
|
||||
(when scheduled
|
||||
(let* ((time (org-time-string-to-time scheduled))
|
||||
(new-time (time-add time (days-to-time days)))
|
||||
(new-date (format-time-string (org-time-stamp-format) new-time)))
|
||||
(org-entry-put nil "SCHEDULED" new-date)))))
|
||||
nil 'tree))
|
||||
(lambda () (org-id-get-create))
|
||||
nil 'tree)))
|
||||
#+end_src
|
||||
|
||||
#+RESULTS:
|
||||
: gortium/add-ids-to-subtree
|
||||
|
||||
* Custom function Open link in other frame
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
|
||||
@@ -150,7 +150,7 @@
|
||||
|
||||
(setq org-global-properties
|
||||
'(("Effort_ALL" . "0:10 0:30 1:00 2:00 4:00 8:00")
|
||||
("ASSIGNEE_ALL" . "Thierry.P Cath.F Martin.K Michel.B Gabriel.C Silvie.L George.G Miguel.A Réjean.S Dominique Adnane Helper1 Helper2")))
|
||||
("ASSIGNEE_ALL" . "Thierry.P Cath.F Martin.K Michel.B Gabriel.C Silvie.L George.G Miguel.A Réjean.S Dominique Adnane Hatim.K Marc-Antoine.P")))
|
||||
|
||||
(setq org-stuck-projects
|
||||
'("TODO=\"PROJ\"" ("NEXT") nil ""))
|
||||
@@ -336,9 +336,11 @@
|
||||
)
|
||||
("wP" "THE PLAN"
|
||||
((agenda ""
|
||||
((org-agenda-span 'month)
|
||||
((org-agenda-span 60)
|
||||
(org-agenda-start-day nil)
|
||||
(org-agenda-overriding-header "📅 THE PLAN"))
|
||||
(org-agenda-overriding-header "📅 THE PLAN")
|
||||
(org-agenda-prefix-format " %?-12t%-12s")
|
||||
)
|
||||
)
|
||||
)
|
||||
((org-agenda-tag-filter-preset '("+work")))
|
||||
@@ -362,6 +364,9 @@
|
||||
)
|
||||
)
|
||||
|
||||
(after! ox-latex
|
||||
(setq org-latex-compiler "xelatex"))
|
||||
|
||||
(after! org
|
||||
(setq
|
||||
org-capture-templates
|
||||
@@ -401,8 +406,18 @@
|
||||
(setq elgantt--display-rules nil)
|
||||
|
||||
(defface gortium/elgantt-weekend-face
|
||||
'((t (:background "#332222" :extend nil)))
|
||||
"Face for weekend vertical columns in ElGantt.")
|
||||
'((t (:background "#32302f" :extend nil)))
|
||||
"Gruvbox Dark0_Hard/Soft mix for subtle weekend stripes.")
|
||||
|
||||
(defun gortium/internal--month-to-num (name)
|
||||
"Convert month string to number safely."
|
||||
(let ((case-fold-search t))
|
||||
(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 "May" name) 5) ((string-match-p "Jun" name) 6)
|
||||
((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 "Nov" name) 11) ((string-match-p "Dec" name) 12) (t 1))))
|
||||
|
||||
(defun gortium/elgantt-draw-weekend-guides ()
|
||||
"Draw weekend guides for the ENTIRE buffer once to prevent scroll lag."
|
||||
@@ -474,7 +489,7 @@
|
||||
(setq elgantt-start-date "2026-01-01")
|
||||
|
||||
(setq elgantt-header-column-offset 40
|
||||
elgantt-header-type 'outline
|
||||
elgantt-header-type 'root
|
||||
elgantt-show-header-depth t
|
||||
elgantt-insert-blank-line-between-top-level-header t
|
||||
elgantt-startup-folded nil
|
||||
@@ -551,7 +566,7 @@
|
||||
(org-set-property "BLOCKER" (format "ids(%s)" new-id)))
|
||||
(message "Added blocker: %s" new-id)))))))
|
||||
|
||||
;; --- 5. Blocker Lines (Multi-ID & Sync Support) ---
|
||||
;; --- 5. Blocker Lines (Surgical Alignment Fix) ---
|
||||
(elgantt-create-display-rule draw-blocker-lines
|
||||
:parser ((blocker-raw . ((org-entry-get (point) "BLOCKER"))))
|
||||
:args (elgantt-org-id)
|
||||
@@ -560,31 +575,34 @@
|
||||
(ids-string (if (string-match "ids(\\(.*?\\))" blocker-raw)
|
||||
(match-string 1 blocker-raw)
|
||||
blocker-raw))
|
||||
;; Supports spaces or commas as separators
|
||||
(id-list (split-string ids-string "[ ,]+" t)))
|
||||
(dolist (blocker-id id-list)
|
||||
(save-excursion
|
||||
(when (elgantt--goto-id blocker-id)
|
||||
(let* ((blocker-data (elgantt-with-point-at-orig-entry nil
|
||||
(list (org-entry-get (point) "SCHEDULED")
|
||||
(org-entry-get (point) "EFFORT"))))
|
||||
(b-sched (car blocker-data))
|
||||
(b-effort (cadr blocker-data)))
|
||||
(org-entry-get (point) "EFFORT")
|
||||
(org-entry-get (point) "WEEKEND_DAYS"))))
|
||||
(b-sched (nth 0 blocker-data))
|
||||
(b-effort (nth 1 blocker-data))
|
||||
(b-wknd (when (nth 2 blocker-data) (string-to-number (nth 2 blocker-data)))))
|
||||
(when (and b-sched b-effort)
|
||||
(let* ((start-ts (ts-parse b-sched))
|
||||
(raw-mins (org-duration-to-minutes b-effort))
|
||||
(days-count (ceiling (/ (float raw-mins) 1440.0)))
|
||||
(p-start-base (save-excursion
|
||||
(elgantt--goto-date (ts-format "%Y-%m-%d" start-ts))
|
||||
(point))))
|
||||
(when (and (numberp p-start-base) (numberp p-blocked))
|
||||
;; FIX 1: compute p-line-start by date (handles "|" separators)
|
||||
;; FIX 2: keep original "Rule of 2" behavior to avoid +1 day overshoot
|
||||
(let* ((end-ts (ts-adjust 'day (- days-count 2) start-ts))
|
||||
;; 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-ts))
|
||||
(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"))))))))))))))
|
||||
@@ -1540,239 +1558,306 @@ If FILE is nil, refile in the current file."
|
||||
|
||||
(add-hook 'ediff-prepare-buffer-hook 'org-ediff-prepare-buffer)
|
||||
|
||||
(defun gortium/add-trigger-scheduling-next ()
|
||||
"Add scheduled chain for this entry."
|
||||
(interactive)
|
||||
(org-set-property "TRIGGER" "next-sibling scheduled!(\"++0d\") todo!(NEXT) chain!(\"TRIGGER\")"))
|
||||
;;; ============================================================
|
||||
;;; GORTIUM — Org chain scheduler (timestamp-based, no duplicates)
|
||||
;;; ============================================================
|
||||
|
||||
(defun gortium/org-schedule-after-previous-sibling ()
|
||||
"Schedule the current task right after its previous sibling.
|
||||
If the sibling is DONE, use its CLOSED time.
|
||||
Otherwise, use SCHEDULED + EFFORT."
|
||||
(interactive)
|
||||
(unless (org-at-heading-p)
|
||||
(org-back-to-heading t))
|
||||
(let ((current-level (org-current-level))
|
||||
(current-point (point))
|
||||
prev-end-time)
|
||||
(save-excursion
|
||||
;; Find previous sibling of same level
|
||||
(let ((found nil))
|
||||
(while (and (not found) (outline-previous-heading))
|
||||
(when (= (org-current-level) current-level)
|
||||
(setq found t)))
|
||||
(unless found
|
||||
(user-error "No previous sibling found"))
|
||||
;; At previous sibling now
|
||||
(let* ((state (org-get-todo-state))
|
||||
(scheduled (org-entry-get nil "SCHEDULED"))
|
||||
(closed (org-entry-get nil "CLOSED"))
|
||||
(effort (org-entry-get nil "EFFORT")))
|
||||
(cond
|
||||
;; If task is DONE and CLOSED exists
|
||||
((and (member state org-done-keywords) closed)
|
||||
(setq prev-end-time (org-time-string-to-time closed)))
|
||||
;; Else use SCHEDULED + EFFORT
|
||||
((and scheduled effort)
|
||||
(let* ((sched-time (org-time-string-to-time scheduled))
|
||||
(duration-min (org-duration-to-minutes effort)))
|
||||
(setq prev-end-time
|
||||
(time-add sched-time (seconds-to-time (* 60 duration-min))))))
|
||||
(t
|
||||
(user-error "Previous sibling missing SCHEDULED/CLOSED or EFFORT"))))))
|
||||
;; Schedule current task
|
||||
(goto-char current-point)
|
||||
(org-schedule nil (format-time-string (org-time-stamp-format t) prev-end-time))))
|
||||
(require 'org)
|
||||
(require 'org-id)
|
||||
(require 'cl-lib)
|
||||
(require 's)
|
||||
|
||||
;; --- Helper: Snap to working hours (8-16) ---
|
||||
;; --- Helper: Snap to working hours (8-16) ---
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Skip weekends (snap to next weekday at 08:00)
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/org--skip-weekend (time)
|
||||
(let* ((decoded (decode-time time))
|
||||
(dow (nth 6 decoded)))
|
||||
(cond
|
||||
((= dow 6) ;; Saturday
|
||||
(apply #'encode-time
|
||||
(append '(0 0 8)
|
||||
(nthcdr 3 (decode-time (time-add time (days-to-time 2)))))))
|
||||
((= dow 0) ;; Sunday
|
||||
(apply #'encode-time
|
||||
(append '(0 0 8)
|
||||
(nthcdr 3 (decode-time (time-add time (days-to-time 1)))))))
|
||||
(t time))))
|
||||
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Snap to working hours (08:00–16:00)
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/internal--snap-to-working-hours (time)
|
||||
(let* ((day-start 8) (day-end 16)
|
||||
(let* ((day-start 8)
|
||||
(day-end 16)
|
||||
(t1 (gortium/org--skip-weekend time))
|
||||
(d (decode-time t1)) (h (nth 2 d)))
|
||||
(cond
|
||||
((< h day-start) (apply #'encode-time (append (list 0 0 day-start) (nthcdr 3 d))))
|
||||
(d (decode-time t1))
|
||||
(h (nth 2 d)))
|
||||
(cond
|
||||
((< h day-start)
|
||||
(apply #'encode-time (append (list 0 0 day-start) (nthcdr 3 d))))
|
||||
((>= h day-end)
|
||||
(let ((next (time-add t1 (days-to-time 1))))
|
||||
(gortium/org--skip-weekend (apply #'encode-time (append (list 0 0 day-start) (nthcdr 3 (decode-time next)))))))
|
||||
(gortium/org--skip-weekend
|
||||
(apply #'encode-time (append (list 0 0 day-start)
|
||||
(nthcdr 3 (decode-time next)))))))
|
||||
(t t1))))
|
||||
|
||||
;; --- Helper: Calculate End Time & Weekend Jump (THE WALKER FIX) ---
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Calculate task span using EFFORT (hour-grained)
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/internal--calculate-task-span (start-time effort-str)
|
||||
"Return a list (END-TIME WEEKEND-DAYS) for given START-TIME and EFFORT string."
|
||||
(if (or (null effort-str) (string-empty-p effort-str))
|
||||
(list start-time 0)
|
||||
(let* ((eff-mins (org-duration-to-minutes effort-str))
|
||||
;; SMART MATH: If string has "d", divide by 1440 (24h). If only "h", divide by 480 (8h).
|
||||
(divisor (if (string-match-p "d" effort-str) 1440.0 480.0))
|
||||
(eff-days (max 1 (ceiling (/ (float eff-mins) divisor))))
|
||||
(total-work-mins (if (string-match-p "d" effort-str)
|
||||
(* (/ eff-mins 1440.0) 480)
|
||||
eff-mins))
|
||||
(cursor start-time)
|
||||
(days-worked 0)
|
||||
(wknd-count 0))
|
||||
|
||||
;; THE WALKER: Simulate the task day by day
|
||||
(while (< days-worked eff-days)
|
||||
(let* ((dow (nth 6 (decode-time cursor))))
|
||||
(wknd-count 0)
|
||||
(day-start 8)
|
||||
(day-end 16))
|
||||
(while (> total-work-mins 0)
|
||||
(let* ((decoded (decode-time cursor))
|
||||
(h (nth 2 decoded))
|
||||
(m (nth 1 decoded))
|
||||
(dow (nth 6 decoded))
|
||||
(current-abs-min (+ (* h 60) m))
|
||||
(day-end-abs-min (* day-end 60))
|
||||
(mins-left-today (- day-end-abs-min current-abs-min)))
|
||||
(cond
|
||||
;; If Sat (6) or Sun (0), it's a weekend. Count it, but don't advance work.
|
||||
((or (= dow 6) (= dow 0))
|
||||
((or (= dow 6) (= dow 0)) ;; weekend
|
||||
(setq wknd-count (1+ wknd-count))
|
||||
(setq cursor (time-add cursor (days-to-time 1))))
|
||||
;; If Mon-Fri, it's a work day. Advance work count.
|
||||
(t
|
||||
(setq days-worked (1+ days-worked))
|
||||
;; Move cursor to start of next day
|
||||
(setq cursor (time-add cursor (days-to-time 1)))))))
|
||||
|
||||
;; Return [End-Time, Weekend-Days-Count]
|
||||
(setq cursor (apply #'encode-time (append (list 0 0 day-start)
|
||||
(nthcdr 3 (decode-time
|
||||
(time-add cursor (days-to-time 1))))))))
|
||||
((<= mins-left-today 0) ;; after hours
|
||||
(setq cursor (apply #'encode-time (append (list 0 0 day-start)
|
||||
(nthcdr 3 (decode-time
|
||||
(time-add cursor (days-to-time 1))))))))
|
||||
((<= total-work-mins mins-left-today)
|
||||
(setq cursor (time-add cursor (seconds-to-time (* total-work-mins 60))))
|
||||
(setq total-work-mins 0))
|
||||
(t ;; spill to next day
|
||||
(setq total-work-mins (- total-work-mins mins-left-today))
|
||||
(setq cursor (time-add cursor (seconds-to-time (* mins-left-today 60))))))))
|
||||
(list cursor wknd-count))))
|
||||
|
||||
;; --- Helper: Find Blocker End Time ---
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Find dependency end time
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/internal--get-blocker-end (blocker-str current-pos task-end-map)
|
||||
(let ((clean (s-trim blocker-str)) (latest-time nil))
|
||||
"Return the latest end time among the dependencies listed in BLOCKER-STR."
|
||||
(let ((clean (s-trim (format "%s" blocker-str)))
|
||||
(latest-time nil))
|
||||
(cond
|
||||
((string-match-p "previous-sibling" clean)
|
||||
(save-excursion
|
||||
(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) (setq found t)))))))
|
||||
(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)
|
||||
(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))
|
||||
(let ((tend (gethash (replace-regexp-in-string "[\"']\\|id:" "" tid) task-end-map)))
|
||||
(when (and tend (or (null latest-time) (time-less-p latest-time tend)))
|
||||
(when (and tend
|
||||
(or (null latest-time)
|
||||
(time-less-p latest-time tend)))
|
||||
(setq latest-time tend))))))
|
||||
latest-time))
|
||||
|
||||
;; --- Helper: Write Properties (Safe) ---
|
||||
(defun gortium/internal--update-properties (pos start wknd id end task-end-map)
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Get earliest timestamp in entry
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/org--get-anchor-time ()
|
||||
"Return the earliest timestamp in current entry, or nil."
|
||||
(save-excursion
|
||||
(goto-char pos) ;; POS is a MARKER
|
||||
(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)))
|
||||
|
||||
;; ------------------------------------------------------------
|
||||
;; Helper: Write timestamp range (NO SCHEDULED)
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/internal--update-properties (pos start wknd id end task-end-map &optional fixed original-start)
|
||||
"Update WEEKEND_DAYS and write the time range at POS.
|
||||
For fixed tasks, ORIGINAL-START is preserved. OLD SCHEDULED/range lines are removed.
|
||||
The range is inserted directly below the heading, before any drawers."
|
||||
(save-excursion
|
||||
(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-put (point) "WEEKEND_DAYS" nil))
|
||||
(org-schedule nil (format-time-string "<%Y-%m-%d %a %H:%M>" start))
|
||||
(puthash id end task-end-map)))
|
||||
(org-entry-delete (point) "WEEKEND_DAYS"))
|
||||
|
||||
(defun gortium/org--skip-weekend (time)
|
||||
"Advance TIME to the next Monday morning if it falls on a weekend."
|
||||
(let* ((decoded (decode-time time))
|
||||
(dow (nth 6 decoded)))
|
||||
(cond
|
||||
((= dow 6) ;; Saturday
|
||||
(let ((next (time-add time (days-to-time 2))))
|
||||
(apply #'encode-time (append '(0 0 8) (nthcdr 3 (decode-time next))))))
|
||||
((= dow 0) ;; Sunday
|
||||
(let ((next (time-add time (days-to-time 1))))
|
||||
(apply #'encode-time (append '(0 0 8) (nthcdr 3 (decode-time next))))))
|
||||
(t time))))
|
||||
|
||||
;; --- MAIN FUNCTION ---
|
||||
(defun gortium/org-schedule-subtree-chains ()
|
||||
"Schedule tasks using MARKERS and WALKER logic."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(message "--- Starting Gantt Scheduler ---")
|
||||
(let* ((all-tasks '()) (task-end-times (make-hash-table :test 'equal)))
|
||||
|
||||
;; Collection
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
(when (org-get-todo-state) ;; Strict TODO check
|
||||
(let ((effort (org-entry-get (point) "EFFORT" nil))
|
||||
(blocker (org-entry-get (point) "BLOCKER" nil))
|
||||
(fixed (org-entry-get (point) "FIXED" nil))
|
||||
(scheduled (org-entry-get (point) "SCHEDULED")))
|
||||
(when (or effort blocker fixed)
|
||||
(push (list (point-marker) (org-id-get-create) (org-get-heading t t t t)
|
||||
effort (when blocker (s-trim blocker)) fixed scheduled
|
||||
(org-entry-get (point) "OFFSET_DAYS" nil)) all-tasks)))))
|
||||
nil (if (org-at-heading-p) 'tree nil))
|
||||
(setq all-tasks (nreverse all-tasks))
|
||||
|
||||
;; Pass 1: FIXED
|
||||
(dolist (task all-tasks)
|
||||
(pcase-let ((`(,pos ,id ,heading ,effort ,blocker ,fixed ,scheduled ,offset) task))
|
||||
(when (and fixed (member (downcase fixed) '("t" "true" "yes")))
|
||||
(if scheduled
|
||||
(let* ((start (org-time-string-to-time scheduled))
|
||||
(span (gortium/internal--calculate-task-span start effort)))
|
||||
(save-excursion
|
||||
(goto-char pos)
|
||||
(if (and (cadr span) (> (cadr span) 0))
|
||||
(org-entry-put (point) "WEEKEND_DAYS" (number-to-string (cadr span)))
|
||||
(org-entry-put (point) "WEEKEND_DAYS" nil))
|
||||
(puthash id (car span) task-end-times)))
|
||||
(message "WARNING: Fixed task '%s' missing date." heading)))))
|
||||
|
||||
;; Pass 2: CHAINS
|
||||
(let* ((remaining (cl-remove-if (lambda (tk) (or (nth 5 tk) (not (nth 4 tk)))) all-tasks))
|
||||
(iter 0) (limit (* 5 (length all-tasks))))
|
||||
(while (and remaining (< iter limit))
|
||||
(cl-incf iter)
|
||||
(let ((scheduled-this-loop '()))
|
||||
(dolist (task remaining)
|
||||
(pcase-let ((`(,pos ,id ,heading ,effort ,blocker ,fixed ,scheduled ,offset) task))
|
||||
(let ((dep-end (gortium/internal--get-blocker-end blocker pos task-end-times)))
|
||||
(when dep-end
|
||||
(let* ((off-val (if offset (string-to-number offset) 0))
|
||||
(base-start (time-add dep-end (days-to-time off-val)))
|
||||
(start (gortium/internal--snap-to-working-hours base-start))
|
||||
(span (gortium/internal--calculate-task-span start effort)))
|
||||
(gortium/internal--update-properties pos start (cadr span) id (car span) task-end-times)
|
||||
(push task scheduled-this-loop))))))
|
||||
(setq remaining (cl-remove-if (lambda (tk) (member tk scheduled-this-loop)) remaining))))
|
||||
|
||||
(dolist (task all-tasks) (set-marker (car task) nil)) ;; Clean markers
|
||||
(message "--- Scheduler Finished ---")))))
|
||||
|
||||
;; USAGE:
|
||||
;; 1. Set up your tasks with either:
|
||||
;; - :FIXED: t and a SCHEDULED date, OR
|
||||
;; - :BLOCKER: previous-sibling / ids(UUID) / ids("id:UUID") / parent
|
||||
;; 2. Put cursor on "Planning" heading
|
||||
;; 3. M-x gortium/org-schedule-subtree-chains
|
||||
;;
|
||||
;; The function will:
|
||||
;; - Use FIXED tasks as anchors
|
||||
;; - Calculate all other tasks from their dependencies
|
||||
;; - Warn about tasks without BLOCKER or FIXED
|
||||
;; - Detect circular dependencies
|
||||
;; - Respect 8-hour workday limits
|
||||
;; - Skip weekends
|
||||
;;
|
||||
;; Supported BLOCKER types (standard EDNA format):
|
||||
;; - previous-sibling
|
||||
;; - ids(UUID) - e.g., ids(70d8f844-1952-43f0-8043-da51e8c8bc69)
|
||||
;; - ids("id:UUID") - e.g., ids("id:70d8f844-1952-43f0-8043-da51e8c8bc69")
|
||||
;; - parent
|
||||
|
||||
(defun gortium/add-ids-to-subtree ()
|
||||
"Add IDs to all headings in current subtree."
|
||||
(interactive)
|
||||
;; Remove old ranges or SCHEDULED lines
|
||||
(save-excursion
|
||||
(org-back-to-heading t)
|
||||
(org-map-entries
|
||||
(lambda () (org-id-get-create))
|
||||
nil 'tree)))
|
||||
(let ((limit (save-excursion (outline-next-heading) (point))))
|
||||
(forward-line 1)
|
||||
(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))))))
|
||||
|
||||
;; Custom function to shift projects
|
||||
(defun gortium/org-shift-subtree-schedules (days)
|
||||
"Shift all SCHEDULED dates in the current subtree by DAYS."
|
||||
(interactive "nDays to shift: ")
|
||||
;; Determine insertion point: after heading, before drawers
|
||||
(let ((insert-point (save-excursion
|
||||
(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
|
||||
(puthash id end task-end-map)))
|
||||
|
||||
;; ------------------------------------------------------------
|
||||
;; MAIN FUNCTION
|
||||
;; ------------------------------------------------------------
|
||||
(defun gortium/org-schedule-subtree-chains ()
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(message "--- Starting Global Gantt Scheduler ---")
|
||||
(let ((all-tasks '())
|
||||
(task-end-times (make-hash-table :test 'equal))
|
||||
(task-end-for-blockers (make-hash-table :test 'equal)))
|
||||
;; COLLECTION
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
(let ((state (org-get-todo-state)))
|
||||
(when state
|
||||
(let* ((pos (point-marker))
|
||||
(id (org-id-get-create))
|
||||
(effort (org-entry-get (point) "EFFORT"))
|
||||
(blocker (org-entry-get (point) "BLOCKER"))
|
||||
(fixed (org-entry-get (point) "FIXED"))
|
||||
(anchor (or (org-get-scheduled-time (point))
|
||||
(gortium/org--get-anchor-time)))
|
||||
(closed (org-entry-get (point) "CLOSED"))
|
||||
(offset (org-entry-get (point) "OFFSET_DAYS")))
|
||||
(when (or effort blocker fixed (string= state "DONE"))
|
||||
(push (list pos id effort blocker fixed anchor offset state closed)
|
||||
all-tasks))))))
|
||||
nil nil)
|
||||
(setq all-tasks (nreverse all-tasks))
|
||||
|
||||
;; PASS 1: DONE & FIXED
|
||||
(dolist (task all-tasks)
|
||||
(pcase-let ((`(,pos ,id ,effort ,_ ,fixed ,anchor ,_ ,state ,closed) task))
|
||||
(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))
|
||||
(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 ---"))))
|
||||
|
||||
;; ---------------------------------------------
|
||||
(defun gortium/org-ensure-task-properties ()
|
||||
"Iterate through all tasks (TODO, NEXT, STRT, WAIT, HOLD, DONE, etc.)
|
||||
and ensure the standard property drawer exists without overwriting existing data."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(message "--- Initializing Task Properties for all states ---")
|
||||
(let ((count 0)
|
||||
;; List of properties to ensure exist
|
||||
(props '("EFFORT" "BLOCKER" "FIXED" "WEEKEND_DAYS"
|
||||
"ASSIGNEE" "RESOURCES" "CATEGORY"
|
||||
"DIMENTIONS" "WEIGHT")))
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
;; This check returns true if the heading has ANY todo keyword
|
||||
(let ((todo-state (org-get-todo-state)))
|
||||
(when todo-state
|
||||
(cl-incf count)
|
||||
;; 1. Handle ID (builtin handles 'do not replace' logic)
|
||||
(org-id-get-create)
|
||||
|
||||
;; 2. Ensure all other keys exist
|
||||
(dolist (prop props)
|
||||
;; Only add the property if it's currently nil/missing
|
||||
(unless (org-entry-get (point) prop)
|
||||
(org-entry-put (point) prop
|
||||
(if (string= prop "FIXED") "nil" "")))))))
|
||||
nil nil)
|
||||
(message "--- Finished: Processed %d tasks across all states ---" count))))
|
||||
|
||||
(defun gortium/add-ids-to-subtree ()
|
||||
"Add IDs to all headings in current subtree."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(org-back-to-heading t)
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
(let ((scheduled (org-entry-get nil "SCHEDULED")))
|
||||
(when scheduled
|
||||
(let* ((time (org-time-string-to-time scheduled))
|
||||
(new-time (time-add time (days-to-time days)))
|
||||
(new-date (format-time-string (org-time-stamp-format) new-time)))
|
||||
(org-entry-put nil "SCHEDULED" new-date)))))
|
||||
nil 'tree))
|
||||
(lambda () (org-id-get-create))
|
||||
nil 'tree)))
|
||||
|
||||
;; Open link in another frame
|
||||
(defun gortium/org-open-link-in-other-frame ()
|
||||
|
||||
Reference in New Issue
Block a user