2 files changed, 56 insertions(+), 16 deletions(-)

M README.md
M time-block.el

@@ 32,6 32,11 @@ This variable is an alist of names (keywords) to group definitions.  A
 group definition is an alist from days of the week (as numbers, Sunday
 = 0/7, etc.) to lists of start/stop pairs (times in "HH:MM" form).
 
+It is also possible to ignore time blocking on holidays.  This is
+globally set using the `time-block-skip-on-holidays-p' variable.  This
+defaults to nil, which does not ignore blocking on holidays.  If set
+to t, time blocking will be ignored on holidays.
+
 ### Defining Time Blocked Commands
 
 Commands are only time-blocked if they're defined.  This is done using

@@ 2,7 2,7 @@
 
 ;; Author: Samuel W. Flint <swflint@flintfam.org>
 ;; URL: https://git.sr.ht/~swflint/time-block
-;; Version: 1.0.0
+;; Version: 1.1.0
 ;; Package-Requires: ((emacs "25.1") (ts "0.1"))
 ;; Keywords: tools, productivity, convenience
 


@@ 37,7 37,8 @@
 ;;
 ;;;;  Time Blocking Groups
 ;;
-;; Customize the variable `time-block-groups'.  An example of a groups definition is below.
+;; Customize the variable `time-block-groups'.  An example of a groups
+;; definition is below.
 ;;
 ;; (setf time-block-groups '((workday . ((1 . (("09:00" . "17:00")))
 ;;                                       (2 . (("09:00" . "17:00")))


@@ 45,6 46,15 @@
 ;;                                       (4 . (("09:00" . "17:00")))
 ;;                                       (5 . (("09:00" . "17:00")))))))
 ;;
+;; This variable is an alist of names (keywords) to group definitions.  A
+;; group definition is an alist from days of the week (as numbers, Sunday
+;; = 0/7, etc.) to lists of start/stop pairs (times in "HH:MM" form).
+;;
+;; It is also possible to ignore time blocking on holidays.  This is
+;; globally set using the `time-block-skip-on-holidays-p' variable.
+;; This defaults to nil, which does not ignore blocking on holidays.
+;; If set to t, time blocking will be ignored on holidays.
+;;
 ;;;; Defining Time Blocked Commands
 ;;
 ;; Commands are only time-blocked if they're defined.  This is done using


@@ 74,6 84,21 @@
 ;;
 ;; (time-block-advise my/elfeed-block-advice 'elfeed workday "You have decided not to check news currently."
 ;;                    "You have decided not to check news currently.\nStill start elfeed?")
+;;
+;;;; Manually advising commands to be time-blocked
+;;
+;; Commands can also be manually advised.  This can be done to prevent
+;; only certain cases from happening.  For instance, I use the following
+;; code to delay myself from editing my emacs configuration during the
+;; workday.
+;;
+;; (defun my/buffer-sets-around-advice (orig name)
+;;   "Check if NAME is 'emacs', if so, follow time blocking logic before calling ORIG (`buffer-sets-load-set')."
+;;   (unless (and (string= name "emacs")
+;;                (time-block-group-blocked-p :workday)
+;;                (not (yes-or-no-p "You have decided not to edit your emacs configuration at this time.\nContinue?")))
+;;     (funcall orig name)))
+;; (advice-add 'buffer-sets-load-set :around #'my/buffer-sets-around-advice)
 
 (require 'ts)
 (require 'cl-lib)


@@ 115,22 140,32 @@ Saturday   6"
 
 (make-obsolete-variable 'time-block-command-groups 'time-block-groups "time-block 0.1.0")
 
+(defcustom time-block-skip-on-holidays-p nil
+  "If t skip checking for time blocking on holidays.  Default to nil."
+  :group 'time-block
+  :type '(choice (const :tag "Continue blocking on holidays." nil)
+                 (const :tag "Do not block on holidays." t)))
+
 (defun time-block-group-blocked-p (block-group)
   "Is group BLOCK-GROUP currently blocked?"
-  (when-let ((group (cl-rest (assoc block-group time-block-groups)))
-             (ts-now (ts-now))
-             (current-day (ts-dow ts-now))
-             (day-blocks (cl-rest (assoc current-day group)))
-             (now (ts-parse (ts-format "%H:%M" ts-now))))
-    (cl-do* ((pair (cl-first day-blocks) (cl-first blocks-left))
-             (blocks-left (cl-rest day-blocks) (cl-rest blocks-left))
-             (start (ts-parse (car pair)) (ts-parse (car pair)))
-             (end (ts-parse (cdr pair)) (ts-parse (cdr pair))))
-        ((or (null blocks-left)
-             (and (ts<= start now)
-                  (ts<= now end)))
-         (and (ts<= start now)
-              (ts<= now end))))))
+  (unless (and time-block-skip-on-holidays-p
+               (not (null (calendar-check-holidays (list (ts-month (ts-now))
+                                                         (ts-day (ts-now))
+                                                         (ts-year (ts-now)))))))
+    (when-let ((group (cl-rest (assoc block-group time-block-groups)))
+               (ts-now (ts-now))
+               (current-day (ts-dow ts-now))
+               (day-blocks (cl-rest (assoc current-day group)))
+               (now (ts-parse (ts-format "%H:%M" ts-now))))
+      (cl-do* ((pair (cl-first day-blocks) (cl-first blocks-left))
+               (blocks-left (cl-rest day-blocks) (cl-rest blocks-left))
+               (start (ts-parse (car pair)) (ts-parse (car pair)))
+               (end (ts-parse (cdr pair)) (ts-parse (cdr pair))))
+          ((or (null blocks-left)
+               (and (ts<= start now)
+                    (ts<= now end)))
+           (and (ts<= start now)
+                (ts<= now end)))))))
 
 (make-obsolete 'timeblock-define-block-command 'define-time-blocked-command "time-block 0.1.0")