Rename all inits, dropping the '-sy' suffix
[syinit] / 11-cal.el
diff --git a/11-cal.el b/11-cal.el
new file mode 100644 (file)
index 0000000..82ab0d7
--- /dev/null
+++ b/11-cal.el
@@ -0,0 +1,633 @@
+;; 11-cal.el --- Calendar Settings
+
+;; Copyright (C) 2007 - 2020 Steve Youngs
+
+;;     Author: Steve Youngs <steve@sxemacs.org>
+;; Maintainer: Steve Youngs <steve@sxemacs.org>
+;;    Created: <2007-12-02>
+;; Time-stamp: <Thursday Apr  9, 2020 08:12:34 steve>
+;;   Download: <https://downloads.sxemacs.org/SYinits>
+;;   HTMLised: <https://www.sxemacs.org/SYinits/11-cal.html>
+;;   Git Repo: git clone https://git.sxemacs.org/syinit
+;;   Keywords: init, compile
+
+;; This file is part of SYinit
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;;
+;; 2. Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in the
+;;    documentation and/or other materials provided with the distribution.
+;;
+;; 3. Neither the name of the author nor the names of any contributors
+;;    may be used to endorse or promote products derived from this
+;;    software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
+;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; Commentary:
+;;
+;;   My calendar/diary settings
+;;
+
+;;; Credits:
+;;
+;;   The HTML version of this file was created with Hrvoje Niksic's
+;;   htmlize.el which is part of the XEmacs "text-modes" package.
+;;
+
+;;; Todo:
+;;
+;;     
+
+;;; Code:
+;:*=======================
+;:* Calendar
+(require 'cedet-compat)
+(require 'diary-lib)
+;(require 'calendar)
+(setq 
+ calendar-latitude -27.47
+ calendar-longitude 153.02
+ calendar-location-name "Brisbane"
+ calendar-time-zone 600
+ cal-tex-diary t
+; calendar-date-display-form ; see: "Howm Integration" below
+; '((if dayname (concat dayname ", ")) day " " monthname " " year)
+ calendar-time-display-form
+ '(24-hours ":" minutes
+           (if time-zone " (") time-zone (if time-zone ")"))
+ calendar-week-start-day 1
+ diary-file (expand-file-name "diary" user-init-directory)
+ diary-mail-addr "steve"
+ diary-mail-days 7
+ european-calendar-style t
+ mark-diary-entries-in-calendar t
+ number-of-diary-entries 7
+ view-diary-entries-initially t)
+
+;; Use a dedicated frame for my calendar
+(setq calendar-and-diary-frame-parameters
+      '((name . "Calendar")
+       (title . "Calendar")
+       (height . 40)
+       (width . 80)
+       (minibuffer . t)
+       (default-toolbar-visible-p . nil)
+       (default-gutter-visible-p . nil)
+       (menubar-visible-p . t))
+      calendar-setup 'one-frame)
+
+;:*=======================
+;:* Todo
+;; Turning this off for a while to see if I can get used to using Howm
+;; more.
+;;(autoload 'todo-mode "todo-mode"
+;;  "Major mode for editing TODO lists." t)
+;;(autoload 'todo-show "todo-mode"
+;;  "Show TODO items." t)
+;;(autoload 'todo-insert-item "todo-mode"
+;;  "Add TODO item." t)
+;;(global-set-key "\C-ct" 'todo-show) ;; switch to TODO buffer
+;;(global-set-key "\C-cn" 'todo-insert-item) ;; insert new item
+;; (setq
+;;  todo-prefix "&%%(todo-cp)"
+;;  todo-file-do (expand-file-name "todo-do" (paths-construct-path
+;;                                        (list user-init-directory
+;;                                              "todo-mode")))
+;;  todo-file-done (expand-file-name "todo-done" (paths-construct-path
+;;                                            (list user-init-directory
+;;                                                  "todo-mode")))
+;;  todo-file-top (expand-file-name "todo-top" (paths-construct-path
+;;                                          (list user-init-directory
+;;                                                "todo-mode")))
+;;  todo-time-string-format "%3b, %d")
+
+;:*=======================
+;:* Fancy Diary with perdy colours!
+(defun sy-hide-fancy-dashes ()
+  "Hides the long lines of dashes from todo-mode in fancy diary display."
+  (save-excursion
+    (goto-char (point-min))
+    (while (re-search-forward "-----" nil t)
+      (set-extent-property
+       (make-extent (match-beginning 0) (1+ (match-end 0)))
+       'invisible t))))
+
+(define-derived-mode fancy-diary-display-mode fundamental-mode "Diary"
+  "Minor mode for displaying Fancy Diary entries buffer."
+  (set (make-local-variable 'font-lock-defaults)
+       '(fancy-diary-font-lock-keywords t))
+  (sy-hide-fancy-dashes)
+  (font-lock-mode)
+  (define-key (current-local-map) "o" 'other-window)
+  (define-key (current-local-map) [space] 'scroll-up-command)
+  (define-key (current-local-map) [backspace] 'scroll-down-command))
+
+(defadvice fancy-diary-display (after set-mode activate)
+  "Give the Fancy Diary Entries buffer a mode of its own.
+
+It has the ever-so-original name of: `fancy-diary-display-mode', adds
+a couple of motion keybindings, and lets you set up font lock keywords
+for a fontified Diary buffer."
+  (save-excursion
+    (set-buffer (get-buffer-create fancy-diary-buffer))
+    (fancy-diary-display-mode)))
+
+(defun fancy-diary-font-lock-keywords ()
+  (let* ((today (regexp-opt (list (calendar-date-string (calendar-current-date)))))
+        (keywords `(("^---\\s-\\(.*$\\)" (1 font-lock-function-name-face))
+                    ("^.*SY:" . font-lock-keyword-face)
+                    ("\"\\(.*\\)\"" (1 font-lock-string-face))
+                    ("`\\(.*?\\)'" (1 font-lock-reference-face))
+                    ("[0-9]+:[0-9]+" . font-lock-warning-face)
+                    (,today . font-lock-warning-face)
+                    ("\\(^.*\\)\n=" (1 font-lock-comment-face)))))
+    keywords))
+
+(defvar fancy-diary-font-lock-keywords (fancy-diary-font-lock-keywords))
+
+;:*=======================
+;:* Display ISO week numbers
+;;
+;; I saw this code mentioned on c.e.x.  I just snarfed what I needed
+;; and SXEmacserised it.
+(require 'cal-iso)
+
+(defvar calendar-use-colours t
+  "Tries to fontify Calendar if non-nil.")
+
+(defvar calendar-week-string "WK"
+  "String (up to three chars) used in calendar header to identify week numbers.")
+
+(defun sy-generate-calendar-month (month year indent)
+  "Produce a calendar for ISO-week, month, year on the Gregorian calendar.
+The calendar is inserted in the buffer starting at the line on which point
+is currently located, but indented INDENT spaces.  The indentation is done
+from the first character on the line and does not disturb the first INDENT
+characters on the line."
+  (let* ((blank-days                   ; At start of month
+          (mod
+           (- (calendar-day-of-week (list month 1 year))
+              calendar-week-start-day)
+           7))
+        (last (calendar-last-day-of-month month year)))
+    (goto-char (point-min))
+    (calendar-insert-indented
+     (calendar-string-spread
+      (list (format "%s %d" (calendar-month-name month) year)) ?  20)
+     indent t)
+    ;; Add colour to month name
+    (if calendar-use-colours
+       (set-extent-property (make-extent (point-min) (1- (point)))
+                    'face 'calendar-header-face))
+    (calendar-insert-indented "" indent) ; Go to proper spot
+    (calendar-for-loop
+     i from 0 to 6 do
+     (insert (substring (aref calendar-day-name-array
+                             (mod (+ calendar-week-start-day i) 7)) 0 2))
+     ;; Add colour to week day names and sundays
+     (if calendar-use-colours
+        (set-extent-property (make-extent  (- (point) 2) (point)) 'face
+                     (if (= 0 (mod (+ calendar-week-start-day i) 7))
+                         'calendar-sunday-face
+                       'calendar-header-face)))
+     (insert " "))
+    ;; Add week-string after week dates
+    (insert (concat calendar-week-string 
+                   (make-string (- 3 (length calendar-week-string)) ? )))
+    ;; Add colour to week-string
+    (if calendar-use-colours
+       (set-extent-property (make-extent  (- (point) 3) (point))
+                    'face 'calendar-week-face))
+    (calendar-insert-indented "" 0 t);; Force onto following line
+    (calendar-insert-indented "" indent);; Go to proper spot
+    ;; Add blank days before the first of the month
+    (calendar-for-loop i from 1 to blank-days do (insert "   "))
+    ;; Put in the days of the month
+    (calendar-for-loop
+     i from 1 to last do
+     (insert (format "%2d " i))
+     (if (not calendar-use-colours)
+        nil
+       (put-text-property (- (point) 3) (1- (point)) 'mouse-face 'highlight)
+       ;; Add colour to sunday
+       (if (= 1 (mod (+ blank-days calendar-week-start-day i) 7))
+          (set-extent-property (make-extent  (- (point) 3) (1- (point)))
+                       'face 'calendar-sunday-face)))
+     (and (zerop (mod (+ i blank-days) 7))
+         ;; Add ISO-week # at the end each week entry
+         (not (insert
+               (format "%2d " (extract-calendar-month
+                               (calendar-iso-from-absolute
+                                (calendar-absolute-from-gregorian
+                                 (list month i year)))))))
+         ;; Add colour to week #
+         (if calendar-use-colours
+             (set-extent-property (make-extent  (- (point) 3) (1- (point)))
+                          'face 'calendar-week-face)
+           t)
+         (/= i last)
+         (calendar-insert-indented "" 0 t);; Force onto following line
+         (calendar-insert-indented "" indent)))));; Go to proper spot
+
+(defalias 'generate-calendar-month #'sy-generate-calendar-month)
+
+;:*=======================
+;:* Hooks
+(add-hook 'diary-display-hook #'fancy-diary-display)
+(add-hook 'diary-hook #'appt-make-list)
+(add-hook 'list-diary-entries-hook
+         #'(lambda ()
+            (sort-diary-entries)
+            (include-other-diary-files)))
+(add-hook 'mark-diary-entries-hook #'mark-included-diary-files)
+(add-hook 'today-visible-calendar-hook #'calendar-mark-today)
+(add-hook 'calendar-move-hook #'(lambda () (diary-view-entries 1)))
+(add-hook 'calendar-mode-hook
+         #'(lambda ()
+             (setq fancy-diary-font-lock-keywords
+                   (fancy-diary-font-lock-keywords))))
+
+;:*=======================
+;:* Holidays
+(defvar displayed-month)
+(defvar displayed-year)
+(require 'holidays)
+
+;; First up, a slightly re-written easter-holiday function
+(defun sy-easter-holidays ()
+  "List of dates related to Easter, as visible in calendar window.
+Ever-so-slightly modified to include the Easter Monday holiday."
+ (if (and (> displayed-month 5) (not all-christian-calendar-holidays))
+     nil;; Ash Wednesday, Good Friday, and Easter are not visible.
+   (let* ((century (1+ (/ displayed-year 100)))
+          (shifted-epact        ;; Age of moon for April 5...
+           (% (+ 14 (* 11 (% displayed-year 19));;     ...by Nicaean rule
+                 (-           ;; ...corrected for the Gregorian century rule
+                  (/ (* 3 century) 4))
+                 (/    ;; ...corrected for Metonic cycle inaccuracy.
+                  (+ 5 (* 8 century)) 25)
+                 (* 30 century));;              Keeps value positive.
+              30))
+          (adjusted-epact       ;;  Adjust for 29.5 day month.
+           (if (or (= shifted-epact 0)
+                   (and (= shifted-epact 1) (< 10 (% displayed-year 19))))
+               (1+ shifted-epact)
+             shifted-epact))
+          (paschal-moon       ;; Day after the full moon on or after March 21.
+           (- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
+              adjusted-epact))
+          (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
+          (mandatory
+           (list
+            (list (calendar-gregorian-from-absolute abs-easter)
+                  "Easter Sunday")
+            (list (calendar-gregorian-from-absolute (- abs-easter 2))
+                  "Good Friday")
+           (list (calendar-gregorian-from-absolute (+ abs-easter 1))
+                 "Easter Monday")
+            (list (calendar-gregorian-from-absolute (- abs-easter 46))
+                  "Ash Wednesday")
+            (list (calendar-gregorian-from-absolute (- abs-easter 47))
+                  "Shrove Tuesday \(Pancake Tuesday\)")))
+          (optional
+           (list
+            (list (calendar-gregorian-from-absolute (- abs-easter 63))
+                  "Septuagesima Sunday")
+            (list (calendar-gregorian-from-absolute (- abs-easter 56))
+                  "Sexagesima Sunday")
+            (list (calendar-gregorian-from-absolute (- abs-easter 49))
+                  "Shrove Sunday")
+            (list (calendar-gregorian-from-absolute (- abs-easter 48))
+                  "Shrove Monday")
+            (list (calendar-gregorian-from-absolute (- abs-easter 14))
+                  "Passion Sunday")
+            (list (calendar-gregorian-from-absolute (- abs-easter 7))
+                  "Palm Sunday")
+            (list (calendar-gregorian-from-absolute (- abs-easter 3))
+                  "Maundy Thursday")
+            (list (calendar-gregorian-from-absolute (+ abs-easter 35))
+                  "Rogation Sunday")
+            (list (calendar-gregorian-from-absolute (+ abs-easter 39))
+                  "Ascension Day")
+            (list (calendar-gregorian-from-absolute (+ abs-easter 49))
+                  "Pentecost (Whitsunday)")
+            (list (calendar-gregorian-from-absolute (+ abs-easter 50))
+                  "Whitmonday")
+            (list (calendar-gregorian-from-absolute (+ abs-easter 56))
+                  "Trinity Sunday")
+            (list (calendar-gregorian-from-absolute (+ abs-easter 60))
+                  "Corpus Christi")))
+          (output-list
+           (filter-visible-calendar-holidays mandatory)))
+     (if all-christian-calendar-holidays
+         (setq output-list
+               (append 
+                (filter-visible-calendar-holidays optional)
+                output-list)))
+     output-list)))
+
+;; Get rid of all the Americanised holidays
+(setq
+ christian-holidays nil
+ hebrew-holidays nil
+ islamic-holidays nil
+ general-holidays nil
+ local-holidays nil
+ oriental-holidays nil
+ other-holidays nil)
+
+;; Set up standard Aussie holidays
+(setq calendar-holidays
+      '((holiday-fixed 1 1 "New Year's Day")
+       ;; If New Year's day is on a weekend the public
+       ;; holiday is the following Monday
+       (if (or (eq 0 (calendar-day-of-week (list 1 1 displayed-year)))
+               (eq 6 (calendar-day-of-week (list 1 1 displayed-year))))
+           (holiday-float 1 1 1 "New Year's Day Public Holiday"))
+       (holiday-fixed 1 26 "Australia Day")
+       ;; If Australia Day falls on a weekend, the
+       ;; holiday is the following Monday
+       (if (eq 0 (calendar-day-of-week (list 1 26 displayed-year)))
+           (holiday-fixed 1 27 "Australia Day Public Holiday"))
+       (if (eq 6 (calendar-day-of-week (list 1 26 displayed-year)))
+           (holiday-fixed 1 28 "Australia Day Public Holiday"))
+       (holiday-fixed 2 14 "Valentine's Day")
+       (holiday-fixed 3 17 "St. Patrick's Day")
+       (holiday-fixed 4 1 "April Fools' Day")
+       (holiday-fixed 4 25 "Anzac Day")
+       ;; If Anzac Day falls on a weekend, the holiday
+       ;; is the following Monday
+       (if (eq 0 (calendar-day-of-week (list 4 25 displayed-year)))
+           (holiday-fixed 4 26 "Anzac Day Public Holiday"))
+       (if (eq 6 (calendar-day-of-week (list 4 25 displayed-year)))
+           (holiday-fixed 4 27 "Anzac Day Public Holiday"))
+       (holiday-float 5 1 1 "Labour Day")
+       (holiday-float 5 0 2 "Mother's Day")
+       (holiday-float 6 1 2 "Queen's Birthday")
+       ;; Brisbane Ekka holiday is on the 2nd Wednesday
+       ;; in August, unless there are 5 Wednesdays in
+       ;; August, then it is the 3rd Wednesday.
+       (if (eq 8 (car (calendar-nth-named-day 5 3 8 displayed-year)))
+           (holiday-float 8 3 3 "Brisbane Show Day")
+         (holiday-float 8 3 2 "Brisbane Show Day"))
+       (holiday-float 9 0 1 "Father's Day")
+       (holiday-fixed 12 25 "Christmas Day")
+       (holiday-fixed 12 26 "Boxing Day")
+       ;; If Xmas falls on weekend, the public holiday
+       ;; is the following Mon/Tue
+       (if (or (eq 0 (calendar-day-of-week (list 12 25 displayed-year)))
+               (eq 6 (calendar-day-of-week (list 12 25 displayed-year))))
+           (holiday-fixed 12 27 "Xmas Day Public Holiday"))
+       (if (or (eq 0 (calendar-day-of-week (list 12 26 displayed-year)))
+               (eq 6 (calendar-day-of-week (list 12 26 displayed-year))))
+           (holiday-fixed 12 28 "Boxing Day Public Holiday"))
+       (solar-equinoxes-solstices)
+       (sy-easter-holidays)))
+(setq mark-holidays-in-calendar t)
+
+;:*=======================
+;:* Appointments
+(require 'appt)
+(require 'balloon-help)
+(balloon-help-mode 1)
+(setq 
+ balloon-help-background "BlanchedAlmond"
+ balloon-help-foreground "Black"
+ display-time-24hr-format t
+ display-time-day-and-date t
+ display-time-no-mail-balloon "What! No mail? That can't be right."
+ display-time-mail-balloon-show-gnus-group t
+ display-time-mail-balloon-max-displayed 20
+ display-time-mail-balloon-gnus-split-width 19
+ display-time-mail-balloon-enhance-gnus-group
+ '("private.*")
+ display-time-mail-balloon-suppress-gnus-group
+ '("\\(SPAM.*\\|returned\\.mail\\)"))
+(display-time)
+(appt-activate 1)
+(setq 
+ appt-message-warning-time 30
+ appt-display-format 'echo
+ appt-audible t
+ appt-display-mode-line t
+ appt-announce-method 'appt-persistent-message-announce)
+(add-hook 'appt-make-list-hook #'appt-included-diary-entries)
+(appt-activate 1)
+
+;:*=======================
+;:* Howm integration
+(setq
+ calendar-date-display-form
+ '("[" year "-" (format "%02d" (string-to-int month))
+   "-" (format "%02d" (string-to-int day)) "] "
+   (if dayname (concat dayname ", ")) day " " monthname " " year))
+
+(defun howm-mark-calendar-date ()
+  (interactive)
+  (let* ((howm-schedule-types
+         howm-schedule-menu-types)
+        (raw (howm-reminder-search
+              howm-schedule-types))
+        (str nil) (yy nil) (mm nil) (dd nil))
+    (while raw
+      (setq str (nth 1 (car raw)))
+      (when
+         (string-match
+          "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)"
+          str)
+       (setq yy (match-string 1 str))
+       (setq mm (match-string 2 str))
+       (setq dd (match-string 3 str)))
+      (when (and yy mm dd)
+       (mark-calendar-date-pattern
+        (string-to-int mm)
+        (string-to-int dd)
+        (string-to-int yy)))
+      (setq mm nil)
+      (setq dd nil)
+      (setq yy nil)
+      (setq raw (cdr raw)))))
+
+(defadvice mark-diary-entries
+  (after mark-howm-entry activate)
+  (howm-mark-calendar-date))
+
+(and-boundp 'howm-menu-display-rules
+  (setq
+   howm-menu-display-rules
+   (cons
+    (cons "%hdiary[\n]?" 'howm-menu-diary)
+    howm-menu-display-rules)))
+
+(defun howm-menu-diary ()
+  (message "scanning diary...")
+  (delete-region
+   (match-beginning 0) (match-end 0))
+  (let* ((now (decode-time (current-time)))
+        (diary-date
+         (list (nth 4 now) (nth 3 now) (nth 5 now)))
+        (diary-display-hook 'ignore)
+        (howm-diary-entry nil)
+        (howm-diary-entry-day nil)
+        (str nil)
+        yy mm dd)
+    (unwind-protect
+       (setq howm-diary-entry
+             (diary-list-entries
+              diary-date howm-menu-schedule-days))
+      (save-excursion
+       (set-buffer
+        (find-buffer-visiting diary-file))
+       (subst-char-in-region
+        (point-min) (point-max) ?\^M ?\n t)
+       (setq selective-display nil)))
+    (while howm-diary-entry
+      (setq howm-diary-entry-day (car howm-diary-entry))
+      (setq mm (nth 0 (car howm-diary-entry-day)))
+      (setq dd (nth 1 (car howm-diary-entry-day)))
+      (setq yy (nth 2 (car howm-diary-entry-day)))
+      (setq str (nth 1 howm-diary-entry-day))
+      (setq howm-diary-entry (cdr howm-diary-entry))
+      (insert
+       (format
+       ">>d [%04d-%02d-%02d] %s\n" yy mm dd str))))
+  (message "scanning diary...done"))
+
+(setq diary-date-forms
+      '((month "/" day "[^/0-9]")
+       (month "/" day "/" year "[^0-9]")
+       ("\\[" year "-" month "-" day "\\]" "[^0-9]")
+       (monthname " *" day "[^,0-9]")
+       (monthname " *" day ", *" year "[^0-9]")
+       (dayname "\\W")))
+
+(defun howm-open-diary (&optional dummy)
+  (interactive)
+  (let ((date-str nil) (str nil))
+    (save-excursion
+      (beginning-of-line)
+      (when (re-search-forward
+            ">>d \\(\\[[-0-9]+\\]\\) " nil t)
+       (setq str
+             (concat
+              "^.+"
+              (buffer-substring-no-properties
+               (point) (line-end-position))))
+       (setq date-str
+             (concat
+              "^.+"
+              (buffer-substring-no-properties
+               (match-beginning 1)
+               (match-end 1))
+              " " str))
+       (find-file
+        (substitute-in-file-name diary-file))
+       (howm-mode t)
+       (goto-char (point-min))
+       (if (re-search-forward date-str nil t)
+           ()
+         (re-search-forward str nil t))))))
+
+(defun add-diary-action-lock-rule ()
+  (let ((rule
+        (action-lock-general
+         'howm-open-diary
+         "^\\(>>d\\) "
+         1 1)))
+    (if (not (member rule action-lock-default-rules))
+       (progn
+         (setq action-lock-default-rules
+               (cons rule action-lock-default-rules))
+         (action-lock-set-rules
+          action-lock-default-rules)))))
+
+(add-hook 'action-lock-mode-on-hook
+         'add-diary-action-lock-rule)
+
+(defadvice make-diary-entry
+  (after howm-mode activate)
+  (text-mode)
+  (howm-mode t))
+
+;;; ;;;;;;;;;;
+
+;;; ;; M-x calendar, move cursor to a certain date, and
+;;; ;; M-x howm-from-calendar to search that date in howm notes.
+(defun howm-from-calendar ()
+  (interactive)
+  (let* ((mdy (calendar-cursor-to-date t))
+        (m (car mdy))
+        (d (second mdy))
+        (y (third mdy))
+        (key (format-time-string
+              howm-date-format
+              (encode-time 0 0 0 d m y))))
+    (howm-keyword-search key)))
+
+;; Bind howm-from-calendar to "H-d" key.
+(add-hook 'initial-calendar-window-hook
+         #'(lambda ()
+           (local-set-key [(hyper ?d)] 'howm-from-calendar)))
+
+       
+
+;; Type "H-d" in howm menu to open calendar.
+(add-hook 'howm-menu-hook
+         #'(lambda ()
+           (local-set-key [(hyper ?d)] 'calendar)))
+
+;:*=======================
+;:* timeclock
+;;  I tried using it for a while but I found that because it wasn't
+;;  automated I never remembered to "clock-in" or "clock-out" and
+;;  change tasks.  I would probably use it if it were a lot more like
+;;  xwem-worklog.
+;;
+;; Track time spent doing certain things
+;; (require 'timeclock)
+;; (setq timeclock-file (expand-file-name "timelog" user-init-directory))
+;; (setq timeclock-relative nil)
+;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
+;; (timeclock-modeline-display)
+
+(define-key ctl-x-map "ti" 'timeclock-in)
+(define-key ctl-x-map "to" 'timeclock-out)
+(define-key ctl-x-map "tc" 'timeclock-change)
+(define-key ctl-x-map "tr" 'timeclock-reread-log)
+(define-key ctl-x-map "tu" 'timeclock-update-modeline)
+(define-key ctl-x-map "tw" 'timeclock-when-to-leave-string)
+
+
+
+;:*=======================
+;:* Start itimer to refresh just after midnight
+;; This needs my `future-run-at-time' advice.
+(run-at-time "00:01" 86400 #'redraw-calendar)
+
+;:*=======================
+;:* Get the show on the road
+(defun sy-calendar-setup ()
+  (mark-diary-entries)
+  (mark-calendar-holidays)
+  (diary-show-all-entries))
+
+(add-hook 'calendar-load-hook 'sy-calendar-setup)
+;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
+(message "Calendar settings loaded")