EXPERIMENTAL/sacha-load.el

   1 (defun sacha/org-show-load ()
   2   "Show my unscheduled time and free time for the day."
   3   (interactive)
   4   (let ((time (sacha/org-calculate-free-time
   5                ;; today
   6                (calendar-gregorian-from-absolute (time-to-days (current-time)))
   7                ;; now
   8                (let* ((now (decode-time))
   9                       (cur-hour (nth 2 now))
  10                       (cur-min (nth 1 now)))
  11                  (+ (* cur-hour 60) cur-min))
  12                ;; until the last time in my time grid
  13                (let ((last (car (last (elt org-agenda-time-grid 2)))))
  14                  (+ (* (/ last 100) 60) (% last 100))))))
  15     (message "%.1f%% load: %d minutes to be scheduled, %d minutes free, %d minutes gap\n"
  16             (/ (car time) (* .01 (cdr time)))
  17             (car time)
  18             (cdr time)
  19             (- (cdr time) (car time)))))
  20
  21 (defun sacha/org-agenda-load (match)
  22   "Can be included in `org-agenda-custom-commands'."
  23   (let ((inhibit-read-only t)
  24         (time (sacha/org-calculate-free-time
  25                ;; today
  26                (calendar-gregorian-from-absolute org-starting-day)
  27                ;; now if today, else start of day
  28                (if (= org-starting-day
  29                       (time-to-days (current-time)))
  30                    (let* ((now (decode-time))
  31                           (cur-hour (nth 2 now))
  32                           (cur-min (nth 1 now)))
  33                      (+ (* cur-hour 60) cur-min))
  34                  (let ((start (car (elt org-agenda-time-grid 2))))
  35                    (+ (* (/ start 100) 60) (% start 100))))
  36                  ;; until the last time in my time grid
  37                (let ((last (car (last (elt org-agenda-time-grid 2)))))
  38                  (+ (* (/ last 100) 60) (% last 100))))))
  39     (goto-char (point-max))
  40     (insert (format
  41              "%.1f%% load: %d minutes to be scheduled, %d minutes free, %d minutes gap\n"
  42              (/ (car time) (* .01 (cdr time)))
  43              (car time)
  44              (cdr time)
  45              (- (cdr time) (car time))))))
  46
  47 (defun sacha/org-calculate-free-time (date start-time end-of-day)
  48   "Return a cons cell of the form (TASK-TIME . FREE-TIME) for DATE, given START-TIME and END-OF-DAY.
  49 DATE is a list of the form (MONTH DAY YEAR).
  50 START-TIME and END-OF-DAY are the number of minutes past midnight."
  51   (save-window-excursion
  52   (let ((files org-agenda-files)
  53         (total-unscheduled 0)
  54         (total-gap 0)
  55         file
  56         rtn
  57         rtnall
  58         entry
  59         (last-timestamp start-time)
  60         scheduled-entries)
  61     (while (setq file (car files))
  62       (catch 'nextfile
  63         (org-check-agenda-file file)
  64         (setq rtn (org-agenda-get-day-entries file date :scheduled :timestamp))
  65         (setq rtnall (append rtnall rtn)))
  66       (setq files (cdr files)))
  67     ;; For each item on the list
  68     (while (setq entry (car rtnall))
  69       (let ((time (get-text-property 1 'time entry)))
  70         (cond
  71          ((and time (string-match "\\([^-]+\\)-\\([^-]+\\)" time))
  72           (setq scheduled-entries (cons (cons
  73                                          (save-match-data (appt-convert-time (match-string 1 time)))
  74                                          (save-match-data (appt-convert-time (match-string 2 time))))
  75                                         scheduled-entries)))
  76          ((and time
  77                (string-match "\\([^-]+\\)\\.+" time)
  78                (string-match "^[A-Z]+ \\(\\[#[A-Z]\\]\\)? \\([0-9]+\\)" (get-text-property 1 'txt entry)))
  79           (setq scheduled-entries
  80                 (let ((start (and (string-match "\\([^-]+\\)\\.+" time)
  81                                  (appt-convert-time (match-string 1 time)))))
  82                   (cons (cons start
  83                               (and (string-match "^[A-Z]+ \\(\\[#[A-Z]\\]\\)? \\([0-9]+\\) " (get-text-property 1 'txt entry))
  84                                    (+ start (string-to-number (match-string 2 (get-text-property 1 'txt entry))))))
  85                         scheduled-entries))))
  86          ((string-match "^[A-Z]+ \\([0-9]+\\)" (get-text-property 1 'txt entry))
  87           (setq total-unscheduled (+ (string-to-number
  88                                       (match-string 1 (get-text-property 1 'txt entry)))
  89                                      total-unscheduled)))))
  90       (setq rtnall (cdr rtnall)))
  91     ;; Sort the scheduled entries by time
  92     (setq scheduled-entries (sort scheduled-entries (lambda (a b) (< (car a) (car b)))))
  93
  94     (while scheduled-entries
  95       (let ((start (car (car scheduled-entries)))
  96             (end (cdr (car scheduled-entries))))
  97       (cond
  98        ;; are we in the middle of this timeslot?
  99        ((and (>= last-timestamp start)
 100              (< = last-timestamp end))
 101         ;; move timestamp later, no change to time
 102         (setq last-timestamp end))
 103        ;; are we completely before this timeslot?
 104        ((< last-timestamp start)
 105         ;; add gap to total, skip to the end
 106         (setq total-gap (+ (- start last-timestamp) total-gap))
 107         (setq last-timestamp end)))
 108       (setq scheduled-entries (cdr scheduled-entries))))
 109     (if (< last-timestamp end-of-day)
 110         (setq total-gap (+ (- end-of-day last-timestamp) total-gap)))
 111     (cons total-unscheduled total-gap))))