Add acdw-org/work-month-headings

1 files changed, 28 insertions, 0 deletions

@@ -386,5 +386,33 @@ instead of the true count."
   (acdw/org-next-heading-widen (- arg)))
 
 
+;;; Add headings for every day of the work month
+;; Gets rid of weekends.
+
+(defun acdw-org/work-month-headings (&optional month year)
+  (interactive (list
+                (read-number "Month: " (car (calendar-current-date)))
+                (read-number "Year: " (nth 2 (calendar-current-date)))))
+  (let ((offset 0)
+        (month (or month
+                   (car (calendar-current-date))))
+        (year (or year
+                  (car (last (calendar-current-date))))))
+    (dotimes (day (calendar-last-day-of-month month year))
+      (let* ((day (1+ day))
+             (day-of-week (calendar-day-of-week (list month day year))))
+        (unless (memq day-of-week '(0 6))           ; weekend
+          (end-of-line)
+          (org-insert-heading nil t t)
+          (insert (concat "[" (mapconcat (lambda (n)
+                                           (format "%02d" n))
+                                         (list year month day)
+                                         "-")
+                          " "
+                          (nth day-of-week '("Sun" "Mon" "Tue" "Wed" "Thu"
+                                             "Fri" "Sat"))
+                          "]")))))))
+
+
 (provide 'acdw-org)
 ;; acdw-org.el ends here