cgit.sxemacs.org Git - syinit/blob - 11-cal.el

   1 ;; 11-cal.el --- Calendar Settings
   2
   3 ;; Copyright (C) 2007 - 2020 Steve Youngs
   4
   5 ;;     Author: Steve Youngs <steve@sxemacs.org>
   6 ;; Maintainer: Steve Youngs <steve@sxemacs.org>
   7 ;;    Created: <2007-12-02>
   8 ;; Time-stamp: <Sunday 11 Apr 2021 14:13:59 (steve)>
   9 ;;   Download: <https://downloads.sxemacs.org/SYinits>
  10 ;;   HTMLised: <https://www.sxemacs.org/SYinits/11-cal.html>
  11 ;;   Git Repo: git clone https://git.sxemacs.org/syinit
  12 ;;   Keywords: init, compile
  13
  14 ;; This file is part of SYinit
  15
  16 ;; Redistribution and use in source and binary forms, with or without
  17 ;; modification, are permitted provided that the following conditions
  18 ;; are met:
  19 ;;
  20 ;; 1. Redistributions of source code must retain the above copyright
  21 ;;    notice, this list of conditions and the following disclaimer.
  22 ;;
  23 ;; 2. Redistributions in binary form must reproduce the above copyright
  24 ;;    notice, this list of conditions and the following disclaimer in the
  25 ;;    documentation and/or other materials provided with the distribution.
  26 ;;
  27 ;; 3. Neither the name of the author nor the names of any contributors
  28 ;;    may be used to endorse or promote products derived from this
  29 ;;    software without specific prior written permission.
  30 ;;
  31 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  32 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  33 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  34 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  35 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  36 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  37 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  38 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  39 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  40 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  41 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  42
  43 ;;; Commentary:
  44 ;;
  45 ;;   My calendar/diary settings
  46 ;;
  47
  48 ;;; Credits:
  49 ;;
  50 ;;   The HTML version of this file was created with Hrvoje Niksic's
  51 ;;   htmlize.el which is part of the XEmacs "text-modes" package.
  52 ;;
  53
  54 ;;; Todo:
  55 ;;
  56 ;;
  57
  58 ;;; Code:
  59 ;:*=======================
  60 ;:* Calendar
  61 (require 'cedet-compat)
  62 (require 'diary-lib)
  63 ;(require 'calendar)
  64 (setq
  65  calendar-latitude [27 35.33 south]
  66  calendar-longitude [153 7.29 east]
  67  calendar-location-name "Rochedale South"
  68  calendar-time-zone 600
  69  cal-tex-diary t
  70 ; calendar-date-display-form ; see: "Howm Integration" below
  71 ; '((if dayname (concat dayname ", ")) day " " monthname " " year)
  72  calendar-time-display-form
  73  '(24-hours ":" minutes
  74             (if time-zone " (") time-zone (if time-zone ")"))
  75  calendar-week-start-day 1
  76  diary-file (expand-file-name "diary" user-init-directory)
  77  diary-mail-addr "steve"
  78  diary-mail-days 7
  79  european-calendar-style t
  80  mark-diary-entries-in-calendar t
  81  number-of-diary-entries 7
  82  view-diary-entries-initially t)
  83
  84 ;; Use a dedicated frame for my calendar
  85 (setq calendar-and-diary-frame-parameters
  86       '((name . "Calendar")
  87         (title . "Calendar")
  88         (height . 40)
  89         (width . 80)
  90         (minibuffer . t)
  91         (default-toolbar-visible-p . nil)
  92         (default-gutter-visible-p . nil)
  93         (menubar-visible-p . t))
  94       calendar-setup 'one-frame)
  95
  96 ;:*=======================
  97 ;:* Todo
  98 ;; Turning this off for a while to see if I can get used to using Howm
  99 ;; more.
 100 ;;(autoload 'todo-mode "todo-mode"
 101 ;;  "Major mode for editing TODO lists." t)
 102 ;;(autoload 'todo-show "todo-mode"
 103 ;;  "Show TODO items." t)
 104 ;;(autoload 'todo-insert-item "todo-mode"
 105 ;;  "Add TODO item." t)
 106 ;;(global-set-key "\C-ct" 'todo-show) ;; switch to TODO buffer
 107 ;;(global-set-key "\C-cn" 'todo-insert-item) ;; insert new item
 108 ;; (setq
 109 ;;  todo-prefix "&%%(todo-cp)"
 110 ;;  todo-file-do (expand-file-name "todo-do" (paths-construct-path
 111 ;;                                         (list user-init-directory
 112 ;;                                               "todo-mode")))
 113 ;;  todo-file-done (expand-file-name "todo-done" (paths-construct-path
 114 ;;                                             (list user-init-directory
 115 ;;                                                   "todo-mode")))
 116 ;;  todo-file-top (expand-file-name "todo-top" (paths-construct-path
 117 ;;                                           (list user-init-directory
 118 ;;                                                 "todo-mode")))
 119 ;;  todo-time-string-format "%3b, %d")
 120
 121 ;:*=======================
 122 ;:* Fancy Diary with perdy colours!
 123 (defun sy-hide-fancy-dashes ()
 124   "Hides the long lines of dashes from todo-mode in fancy diary display."
 125   (save-excursion
 126     (goto-char (point-min))
 127     (while (re-search-forward "-----" nil t)
 128       (set-extent-property
 129        (make-extent (match-beginning 0) (1+ (match-end 0)))
 130        'invisible t))))
 131
 132 (define-derived-mode fancy-diary-display-mode fundamental-mode "Diary"
 133   "Minor mode for displaying Fancy Diary entries buffer."
 134   (set (make-local-variable 'font-lock-defaults)
 135        '(fancy-diary-font-lock-keywords t))
 136   (sy-hide-fancy-dashes)
 137   (font-lock-mode)
 138   (define-key (current-local-map) "o" 'other-window)
 139   (define-key (current-local-map) [space] 'scroll-up-command)
 140   (define-key (current-local-map) [backspace] 'scroll-down-command))
 141
 142 (defadvice fancy-diary-display (after set-mode activate)
 143   "Give the Fancy Diary Entries buffer a mode of its own.
 144
 145 It has the ever-so-original name of: `fancy-diary-display-mode', adds
 146 a couple of motion keybindings, and lets you set up font lock keywords
 147 for a fontified Diary buffer."
 148   (save-excursion
 149     (set-buffer (get-buffer-create fancy-diary-buffer))
 150     (fancy-diary-display-mode)))
 151
 152 (defun fancy-diary-font-lock-keywords ()
 153   (let* ((today (regexp-opt (list (calendar-date-string (calendar-current-date)))))
 154          (keywords `(("^---\\s-\\(.*$\\)" (1 font-lock-function-name-face))
 155                      ("^.*SY:" . font-lock-keyword-face)
 156                      ("\"\\(.*\\)\"" (1 font-lock-string-face))
 157                      ("`\\(.*?\\)'" (1 font-lock-reference-face))
 158                      ("[0-9]+:[0-9]+" . font-lock-warning-face)
 159                      (,today . font-lock-warning-face)
 160                      ("\\(^.*\\)\n=" (1 font-lock-comment-face)))))
 161     keywords))
 162
 163 (defvar fancy-diary-font-lock-keywords (fancy-diary-font-lock-keywords))
 164
 165 ;:*=======================
 166 ;:* Display ISO week numbers
 167 ;;
 168 ;; I saw this code mentioned on c.e.x.  I just snarfed what I needed
 169 ;; and SXEmacserised it.
 170 (require 'cal-iso)
 171
 172 (defvar calendar-use-colours t
 173   "Tries to fontify Calendar if non-nil.")
 174
 175 (defvar calendar-week-string "WK"
 176   "String (up to three chars) used in calendar header to identify week numbers.")
 177
 178 (defun sy-generate-calendar-month (month year indent)
 179   "Produce a calendar for ISO-week, month, year on the Gregorian calendar.
 180 The calendar is inserted in the buffer starting at the line on which point
 181 is currently located, but indented INDENT spaces.  The indentation is done
 182 from the first character on the line and does not disturb the first INDENT
 183 characters on the line."
 184   (let* ((blank-days                    ; At start of month
 185           (mod
 186            (- (calendar-day-of-week (list month 1 year))
 187               calendar-week-start-day)
 188            7))
 189          (last (calendar-last-day-of-month month year)))
 190     (goto-char (point-min))
 191     (calendar-insert-indented
 192      (calendar-string-spread
 193       (list (format "%s %d" (calendar-month-name month) year)) ?  20)
 194      indent t)
 195     ;; Add colour to month name
 196     (if calendar-use-colours
 197         (set-extent-property (make-extent (point-min) (1- (point)))
 198                      'face 'calendar-header-face))
 199     (calendar-insert-indented "" indent) ; Go to proper spot
 200     (calendar-for-loop
 201      i from 0 to 6 do
 202      (insert (substring (aref calendar-day-name-array
 203                               (mod (+ calendar-week-start-day i) 7)) 0 2))
 204      ;; Add colour to week day names and sundays
 205      (if calendar-use-colours
 206          (set-extent-property (make-extent  (- (point) 2) (point)) 'face
 207                       (if (= 0 (mod (+ calendar-week-start-day i) 7))
 208                           'calendar-sunday-face
 209                         'calendar-header-face)))
 210      (insert " "))
 211     ;; Add week-string after week dates
 212     (insert (concat calendar-week-string
 213                     (make-string (- 3 (length calendar-week-string)) ? )))
 214     ;; Add colour to week-string
 215     (if calendar-use-colours
 216         (set-extent-property (make-extent  (- (point) 3) (point))
 217                      'face 'calendar-week-face))
 218     (calendar-insert-indented "" 0 t);; Force onto following line
 219     (calendar-insert-indented "" indent);; Go to proper spot
 220     ;; Add blank days before the first of the month
 221     (calendar-for-loop i from 1 to blank-days do (insert "   "))
 222     ;; Put in the days of the month
 223     (calendar-for-loop
 224      i from 1 to last do
 225      (insert (format "%2d " i))
 226      (if (not calendar-use-colours)
 227          nil
 228        (put-text-property (- (point) 3) (1- (point)) 'mouse-face 'highlight)
 229        ;; Add colour to sunday
 230        (if (= 1 (mod (+ blank-days calendar-week-start-day i) 7))
 231            (set-extent-property (make-extent  (- (point) 3) (1- (point)))
 232                         'face 'calendar-sunday-face)))
 233      (and (zerop (mod (+ i blank-days) 7))
 234           ;; Add ISO-week # at the end each week entry
 235           (not (insert
 236                 (format "%2d " (extract-calendar-month
 237                                 (calendar-iso-from-absolute
 238                                  (calendar-absolute-from-gregorian
 239                                   (list month i year)))))))
 240           ;; Add colour to week #
 241           (if calendar-use-colours
 242               (set-extent-property (make-extent  (- (point) 3) (1- (point)))
 243                            'face 'calendar-week-face)
 244             t)
 245           (/= i last)
 246           (calendar-insert-indented "" 0 t);; Force onto following line
 247           (calendar-insert-indented "" indent)))));; Go to proper spot
 248
 249 (defalias 'generate-calendar-month #'sy-generate-calendar-month)
 250
 251 ;:*=======================
 252 ;:* Hooks
 253 (add-hook 'diary-display-hook #'fancy-diary-display)
 254 (add-hook 'diary-hook #'appt-make-list)
 255 (add-hook 'list-diary-entries-hook
 256           #'(lambda ()
 257              (sort-diary-entries)
 258              (include-other-diary-files)))
 259 (add-hook 'mark-diary-entries-hook #'mark-included-diary-files)
 260 (add-hook 'today-visible-calendar-hook #'calendar-mark-today)
 261 (add-hook 'calendar-move-hook #'(lambda () (diary-view-entries 1)))
 262 (add-hook 'calendar-mode-hook
 263           #'(lambda ()
 264               (setq fancy-diary-font-lock-keywords
 265                     (fancy-diary-font-lock-keywords))))
 266
 267 ;:*=======================
 268 ;:* Holidays
 269 (defvar displayed-month)
 270 (defvar displayed-year)
 271 (require 'holidays)
 272
 273 ;; First up, a slightly re-written easter-holiday function
 274 (defun sy-easter-holidays ()
 275   "List of dates related to Easter, as visible in calendar window.
 276 Ever-so-slightly modified to include the Easter Monday holiday."
 277  (if (and (> displayed-month 5) (not all-christian-calendar-holidays))
 278      nil;; Ash Wednesday, Good Friday, and Easter are not visible.
 279    (let* ((century (1+ (/ displayed-year 100)))
 280           (shifted-epact        ;; Age of moon for April 5...
 281            (% (+ 14 (* 11 (% displayed-year 19));;     ...by Nicaean rule
 282                  (-           ;; ...corrected for the Gregorian century rule
 283                   (/ (* 3 century) 4))
 284                  (/    ;; ...corrected for Metonic cycle inaccuracy.
 285                   (+ 5 (* 8 century)) 25)
 286                  (* 30 century));;              Keeps value positive.
 287               30))
 288           (adjusted-epact       ;;  Adjust for 29.5 day month.
 289            (if (or (= shifted-epact 0)
 290                    (and (= shifted-epact 1) (< 10 (% displayed-year 19))))
 291                (1+ shifted-epact)
 292              shifted-epact))
 293           (paschal-moon       ;; Day after the full moon on or after March 21.
 294            (- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
 295               adjusted-epact))
 296           (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
 297           (mandatory
 298            (list
 299             (list (calendar-gregorian-from-absolute abs-easter)
 300                   "Easter Sunday")
 301             (list (calendar-gregorian-from-absolute (- abs-easter 2))
 302                   "Good Friday")
 303             (list (calendar-gregorian-from-absolute (+ abs-easter 1))
 304                   "Easter Monday")
 305             (list (calendar-gregorian-from-absolute (- abs-easter 46))
 306                   "Ash Wednesday")
 307             (list (calendar-gregorian-from-absolute (- abs-easter 47))
 308                   "Shrove Tuesday \(Pancake Tuesday\)")))
 309           (optional
 310            (list
 311             (list (calendar-gregorian-from-absolute (- abs-easter 63))
 312                   "Septuagesima Sunday")
 313             (list (calendar-gregorian-from-absolute (- abs-easter 56))
 314                   "Sexagesima Sunday")
 315             (list (calendar-gregorian-from-absolute (- abs-easter 49))
 316                   "Shrove Sunday")
 317             (list (calendar-gregorian-from-absolute (- abs-easter 48))
 318                   "Shrove Monday")
 319             (list (calendar-gregorian-from-absolute (- abs-easter 14))
 320                   "Passion Sunday")
 321             (list (calendar-gregorian-from-absolute (- abs-easter 7))
 322                   "Palm Sunday")
 323             (list (calendar-gregorian-from-absolute (- abs-easter 3))
 324                   "Maundy Thursday")
 325             (list (calendar-gregorian-from-absolute (+ abs-easter 35))
 326                   "Rogation Sunday")
 327             (list (calendar-gregorian-from-absolute (+ abs-easter 39))
 328                   "Ascension Day")
 329             (list (calendar-gregorian-from-absolute (+ abs-easter 49))
 330                   "Pentecost (Whitsunday)")
 331             (list (calendar-gregorian-from-absolute (+ abs-easter 50))
 332                   "Whitmonday")
 333             (list (calendar-gregorian-from-absolute (+ abs-easter 56))
 334                   "Trinity Sunday")
 335             (list (calendar-gregorian-from-absolute (+ abs-easter 60))
 336                   "Corpus Christi")))
 337           (output-list
 338            (filter-visible-calendar-holidays mandatory)))
 339      (if all-christian-calendar-holidays
 340          (setq output-list
 341                (append
 342                 (filter-visible-calendar-holidays optional)
 343                 output-list)))
 344      output-list)))
 345
 346 ;; Get rid of all the Americanised holidays
 347 (setq
 348  christian-holidays nil
 349  hebrew-holidays nil
 350  islamic-holidays nil
 351  general-holidays nil
 352  local-holidays nil
 353  oriental-holidays nil
 354  other-holidays nil)
 355
 356 ;; Set up standard Aussie holidays
 357 (setq calendar-holidays
 358       '((holiday-fixed 1 1 "New Year's Day")
 359         ;; If New Year's day is on a weekend the public
 360         ;; holiday is the following Monday
 361         (if (or (eq 0 (calendar-day-of-week (list 1 1 displayed-year)))
 362                 (eq 6 (calendar-day-of-week (list 1 1 displayed-year))))
 363             (holiday-float 1 1 1 "New Year's Day Public Holiday"))
 364         (holiday-fixed 1 26 "Australia Day")
 365         ;; If Australia Day falls on a weekend, the
 366         ;; holiday is the following Monday
 367         (if (eq 0 (calendar-day-of-week (list 1 26 displayed-year)))
 368             (holiday-fixed 1 27 "Australia Day Public Holiday"))
 369         (if (eq 6 (calendar-day-of-week (list 1 26 displayed-year)))
 370             (holiday-fixed 1 28 "Australia Day Public Holiday"))
 371         (holiday-fixed 2 14 "Valentine's Day")
 372         (holiday-fixed 3 17 "St. Patrick's Day")
 373         (holiday-fixed 4 1 "April Fools' Day")
 374         (holiday-fixed 4 25 "Anzac Day")
 375         ;; If Anzac Day falls on a weekend, the holiday
 376         ;; is the following Monday
 377         (if (eq 0 (calendar-day-of-week (list 4 25 displayed-year)))
 378             (holiday-fixed 4 26 "Anzac Day Public Holiday"))
 379         (if (eq 6 (calendar-day-of-week (list 4 25 displayed-year)))
 380             (holiday-fixed 4 27 "Anzac Day Public Holiday"))
 381         (holiday-float 5 1 1 "Labour Day")
 382         (holiday-float 5 0 2 "Mother's Day")
 383         (holiday-float 6 1 2 "Queen's Birthday")
 384         ;; Brisbane Ekka holiday is on the 2nd Wednesday
 385         ;; in August, unless there are 5 Wednesdays in
 386         ;; August, then it is the 3rd Wednesday.
 387         (if (eq 8 (car (calendar-nth-named-day 5 3 8 displayed-year)))
 388             (holiday-float 8 3 3 "Brisbane Show Day")
 389           (holiday-float 8 3 2 "Brisbane Show Day"))
 390         (holiday-float 9 0 1 "Father's Day")
 391         (holiday-fixed 12 25 "Christmas Day")
 392         (holiday-fixed 12 26 "Boxing Day")
 393         ;; If Xmas falls on weekend, the public holiday
 394         ;; is the following Mon/Tue
 395         (if (or (eq 0 (calendar-day-of-week (list 12 25 displayed-year)))
 396                 (eq 6 (calendar-day-of-week (list 12 25 displayed-year))))
 397             (holiday-fixed 12 27 "Xmas Day Public Holiday"))
 398         (if (or (eq 0 (calendar-day-of-week (list 12 26 displayed-year)))
 399                 (eq 6 (calendar-day-of-week (list 12 26 displayed-year))))
 400             (holiday-fixed 12 28 "Boxing Day Public Holiday"))
 401         (solar-equinoxes-solstices)
 402         (sy-easter-holidays)))
 403 (setq mark-holidays-in-calendar t)
 404
 405 ;:*=======================
 406 ;:* Appointments
 407 (require 'appt)
 408 (require 'balloon-help)
 409 (balloon-help-mode 1)
 410 (setq
 411  balloon-help-background "BlanchedAlmond"
 412  balloon-help-foreground "Black"
 413  display-time-24hr-format t
 414  display-time-day-and-date t
 415  display-time-no-mail-balloon "What! No mail? That can't be right."
 416  display-time-mail-balloon-show-gnus-group t
 417  display-time-mail-balloon-max-displayed 20
 418  display-time-mail-balloon-gnus-split-width 19
 419  display-time-mail-balloon-enhance-gnus-group
 420  '("private.*")
 421  display-time-mail-balloon-suppress-gnus-group
 422  '("\\(SPAM.*\\|returned\\.mail\\)"))
 423 (display-time)
 424 (appt-activate 1)
 425 (setq
 426  appt-message-warning-time 30
 427  appt-display-format 'echo
 428  appt-audible t
 429  appt-display-mode-line t
 430  appt-announce-method 'appt-persistent-message-announce)
 431 (add-hook 'appt-make-list-hook #'appt-included-diary-entries)
 432 (appt-activate 1)
 433
 434 ;:*=======================
 435 ;:* Howm integration
 436 (setq
 437  calendar-date-display-form
 438  '("[" year "-" (format "%02d" (string-to-int month))
 439    "-" (format "%02d" (string-to-int day)) "] "
 440    (if dayname (concat dayname ", ")) day " " monthname " " year))
 441
 442 (defun howm-mark-calendar-date ()
 443   (interactive)
 444   (let* ((howm-schedule-types
 445           howm-schedule-menu-types)
 446          (raw (howm-reminder-search
 447                howm-schedule-types))
 448          (str nil) (yy nil) (mm nil) (dd nil))
 449     (while raw
 450       (setq str (nth 1 (car raw)))
 451       (when
 452           (string-match
 453            "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)"
 454            str)
 455         (setq yy (match-string 1 str))
 456         (setq mm (match-string 2 str))
 457         (setq dd (match-string 3 str)))
 458       (when (and yy mm dd)
 459         (mark-calendar-date-pattern
 460          (string-to-int mm)
 461          (string-to-int dd)
 462          (string-to-int yy)))
 463       (setq mm nil)
 464       (setq dd nil)
 465       (setq yy nil)
 466       (setq raw (cdr raw)))))
 467
 468 (defadvice mark-diary-entries
 469   (after mark-howm-entry activate)
 470   (howm-mark-calendar-date))
 471
 472 (and-boundp 'howm-menu-display-rules
 473   (setq
 474    howm-menu-display-rules
 475    (cons
 476     (cons "%hdiary[\n]?" 'howm-menu-diary)
 477     howm-menu-display-rules)))
 478
 479 (defun howm-menu-diary ()
 480   (message "scanning diary...")
 481   (delete-region
 482    (match-beginning 0) (match-end 0))
 483   (let* ((now (decode-time (current-time)))
 484          (diary-date
 485           (list (nth 4 now) (nth 3 now) (nth 5 now)))
 486          (diary-display-hook 'ignore)
 487          (howm-diary-entry nil)
 488          (howm-diary-entry-day nil)
 489          (str nil)
 490          yy mm dd)
 491     (unwind-protect
 492         (setq howm-diary-entry
 493               (diary-list-entries
 494                diary-date howm-menu-schedule-days))
 495       (save-excursion
 496         (set-buffer
 497          (find-buffer-visiting diary-file))
 498         (subst-char-in-region
 499          (point-min) (point-max) ?\^M ?\n t)
 500         (setq selective-display nil)))
 501     (while howm-diary-entry
 502       (setq howm-diary-entry-day (car howm-diary-entry))
 503       (setq mm (nth 0 (car howm-diary-entry-day)))
 504       (setq dd (nth 1 (car howm-diary-entry-day)))
 505       (setq yy (nth 2 (car howm-diary-entry-day)))
 506       (setq str (nth 1 howm-diary-entry-day))
 507       (setq howm-diary-entry (cdr howm-diary-entry))
 508       (insert
 509        (format
 510         ">>d [%04d-%02d-%02d] %s\n" yy mm dd str))))
 511   (message "scanning diary...done"))
 512
 513 (setq diary-date-forms
 514       '((month "/" day "[^/0-9]")
 515         (month "/" day "/" year "[^0-9]")
 516         ("\\[" year "-" month "-" day "\\]" "[^0-9]")
 517         (monthname " *" day "[^,0-9]")
 518         (monthname " *" day ", *" year "[^0-9]")
 519         (dayname "\\W")))
 520
 521 (defun howm-open-diary (&optional dummy)
 522   (interactive)
 523   (let ((date-str nil) (str nil))
 524     (save-excursion
 525       (beginning-of-line)
 526       (when (re-search-forward
 527              ">>d \\(\\[[-0-9]+\\]\\) " nil t)
 528         (setq str
 529               (concat
 530                "^.+"
 531                (buffer-substring-no-properties
 532                 (point) (line-end-position))))
 533         (setq date-str
 534               (concat
 535                "^.+"
 536                (buffer-substring-no-properties
 537                 (match-beginning 1)
 538                 (match-end 1))
 539                " " str))
 540         (find-file
 541          (substitute-in-file-name diary-file))
 542         (howm-mode t)
 543         (goto-char (point-min))
 544         (if (re-search-forward date-str nil t)
 545             ()
 546           (re-search-forward str nil t))))))
 547
 548 (defun add-diary-action-lock-rule ()
 549   (let ((rule
 550          (action-lock-general
 551           'howm-open-diary
 552           "^\\(>>d\\) "
 553           1 1)))
 554     (if (not (member rule action-lock-default-rules))
 555         (progn
 556           (setq action-lock-default-rules
 557                 (cons rule action-lock-default-rules))
 558           (action-lock-set-rules
 559            action-lock-default-rules)))))
 560
 561 (add-hook 'action-lock-mode-on-hook
 562           'add-diary-action-lock-rule)
 563
 564 (defadvice make-diary-entry
 565   (after howm-mode activate)
 566   (text-mode)
 567   (howm-mode t))
 568
 569 ;;; ;;;;;;;;;;
 570
 571 ;;; ;; M-x calendar, move cursor to a certain date, and
 572 ;;; ;; M-x howm-from-calendar to search that date in howm notes.
 573 (defun howm-from-calendar ()
 574   (interactive)
 575   (let* ((mdy (calendar-cursor-to-date t))
 576          (m (car mdy))
 577          (d (second mdy))
 578          (y (third mdy))
 579          (key (format-time-string
 580                howm-date-format
 581                (encode-time 0 0 0 d m y))))
 582     (howm-keyword-search key)))
 583
 584 ;; Bind howm-from-calendar to "H-d" key.
 585 (add-hook 'initial-calendar-window-hook
 586           #'(lambda ()
 587             (local-set-key [(hyper ?d)] 'howm-from-calendar)))
 588
 589 ;; Type "H-d" in howm menu to open calendar.
 590 (add-hook 'howm-menu-hook
 591           #'(lambda ()
 592             (local-set-key [(hyper ?d)] 'calendar)))
 593
 594 ;:*=======================
 595 ;:* timeclock (keybindings in 90-keys.el)
 596 ;;  I tried using it for a while but I found that because it wasn't
 597 ;;  automated I never remembered to "clock-in" or "clock-out" and
 598 ;;  change tasks.  I would probably use it if it were a lot more like
 599 ;;  xwem-worklog.
 600 ;;
 601 ;; Track time spent doing certain things
 602 ;; (require 'timeclock)
 603 ;; (setq timeclock-file (expand-file-name "timelog" user-init-directory))
 604 ;; (setq timeclock-relative nil)
 605 ;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
 606 ;; (timeclock-modeline-display)
 607
 608 ;:*=======================
 609 ;:* Start itimer to refresh just after midnight
 610 ;; This needs my `future-run-at-time' advice.
 611 (run-at-time "00:01" 86400 #'redraw-calendar)
 612
 613 ;:*=======================
 614 ;:* Get the show on the road
 615 (defun sy-calendar-setup ()
 616   (mark-diary-entries)
 617   (mark-calendar-holidays)
 618   (diary-show-all-entries))
 619
 620 (add-hook 'calendar-load-hook #'sy-calendar-setup)
 621
 622 ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
 623 (message "Calendar settings loaded")