cgit.sxemacs.org Git - syinit/blob - 12-cal-sy.el

   1 ;; 12-cal-sy.el --- Calendar Settings   -*- Emacs-Lisp -*-
   2
   3 ;; Copyright (C) 2007 - 2013 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: <Monday Aug 19, 2013 09:27:26 steve>
   9 ;;   Download: <http://bastard.steveyoungs.com/~steve/SXEmacs/inits/>
  10 ;;   HTMLised: <http://bastard.steveyoungs.com/~steve/SXEmacs/htmlinits/12-cal-sy.html>
  11 ;;   Git Repo: git clone http://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 'diary-lib)
  62 ;(require 'calendar)
  63 (setq
  64  calendar-latitude -27.3
  65  calendar-longitude 153.0
  66  calendar-location-name "Brisbane"
  67  calendar-time-zone 600
  68  calendar-standard-time-zone-name "EST"
  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 "etc/SXEmacs/.diary"
  77                               (getenv "HOME"))
  78  diary-mail-addr "steve"
  79  diary-mail-days 7
  80  european-calendar-style t
  81  mark-diary-entries-in-calendar t
  82  number-of-diary-entries 7
  83  view-diary-entries-initially t)
  84
  85 ;:*=======================
  86 ;:* Todo
  87 ;; Turning this off for a while to see if I can get used to using Howm
  88 ;; more.
  89 ;;(autoload 'todo-mode "todo-mode"
  90 ;;  "Major mode for editing TODO lists." t)
  91 ;;(autoload 'todo-show "todo-mode"
  92 ;;  "Show TODO items." t)
  93 ;;(autoload 'todo-insert-item "todo-mode"
  94 ;;  "Add TODO item." t)
  95 ;;(global-set-key "\C-ct" 'todo-show) ;; switch to TODO buffer
  96 ;;(global-set-key "\C-cn" 'todo-insert-item) ;; insert new item
  97 ;;(setq
  98 ;; todo-prefix "&%%(todo-cp)"
  99 ;; todo-file-do (expand-file-name ".todo-do" (getenv "HOME"))
 100 ;; todo-file-done (expand-file-name ".todo-done" (getenv "HOME"))
 101 ;; todo-file-top (expand-file-name ".todo-top" (getenv "HOME"))
 102 ;; todo-time-string-format "%3b, %d")
 103
 104 ;:*=======================
 105 ;:* Fancy Diary with perdy colours!
 106 (defun sy-hide-fancy-dashes ()
 107   "Hides the long lines of dashes from todo-mode in fancy diary display."
 108   (save-excursion
 109     (goto-char (point-min))
 110     (while (re-search-forward "-----" nil t)
 111       (set-extent-property
 112        (make-extent (match-beginning 0) (1+ (match-end 0)))
 113        'invisible t))))
 114
 115 (define-derived-mode fancy-diary-display-mode fundamental-mode "Diary"
 116   "Minor mode for displaying Fancy Diary entries buffer."
 117   (set (make-local-variable 'font-lock-defaults)
 118        '(fancy-diary-font-lock-keywords t))
 119   (sy-hide-fancy-dashes)
 120   (font-lock-mode)
 121   (define-key (current-local-map) "o" 'other-window)
 122   (define-key (current-local-map) [space] 'scroll-up-command)
 123   (define-key (current-local-map) [backspace] 'scroll-down-command))
 124
 125 (defadvice fancy-diary-display (after set-mode activate)
 126   "Give the Fancy Diary Entries buffer a mode of its own.
 127
 128 It has the ever-so-original name of: `fancy-diary-display-mode', adds
 129 a couple of motion keybindings, and lets you set up font lock keywords
 130 for a fontified Diary buffer."
 131   (save-excursion
 132     (set-buffer (get-buffer-create fancy-diary-buffer))
 133     (fancy-diary-display-mode)))
 134
 135 (defun fancy-diary-font-lock-keywords ()
 136   (let* ((today (regexp-opt (list (calendar-date-string (calendar-current-date)))))
 137          (keywords `(("^---\\s-\\(.*$\\)" (1 font-lock-function-name-face))
 138                      ("^.*SY:" . font-lock-keyword-face)
 139                      ("\"\\(.*\\)\"" (1 font-lock-string-face))
 140                      ("`\\(.*?\\)'" (1 font-lock-reference-face))
 141                      ("[0-9]+:[0-9]+" . font-lock-warning-face)
 142                      (,today . font-lock-warning-face)
 143                      ("\\(^.*\\)\n=" (1 font-lock-comment-face)))))
 144     keywords))
 145
 146 (defvar fancy-diary-font-lock-keywords (fancy-diary-font-lock-keywords))
 147
 148 ;:*=======================
 149 ;:* Display ISO week numbers
 150 ;;
 151 ;; I saw this code mentioned on c.e.x.  I just snarfed what I needed
 152 ;; and SXEmacserised it.
 153 (require 'cal-iso)
 154
 155 (defvar calendar-use-colours t
 156   "Tries to fontify Calendar if non-nil.")
 157
 158 (defvar calendar-week-string "WK"
 159   "String (up to three chars) used in calendar header to identify week numbers.")
 160
 161 (defun sy-generate-calendar-month (month year indent)
 162   "Produce a calendar for ISO-week, month, year on the Gregorian calendar.
 163 The calendar is inserted in the buffer starting at the line on which point
 164 is currently located, but indented INDENT spaces.  The indentation is done
 165 from the first character on the line and does not disturb the first INDENT
 166 characters on the line."
 167   (let* ((blank-days                    ; At start of month
 168           (mod
 169            (- (calendar-day-of-week (list month 1 year))
 170               calendar-week-start-day)
 171            7))
 172          (last (calendar-last-day-of-month month year)))
 173     (goto-char (point-min))
 174     (calendar-insert-indented
 175      (calendar-string-spread
 176       (list (format "%s %d" (calendar-month-name month) year)) ?  20)
 177      indent t)
 178     ;; Add colour to month name
 179     (if calendar-use-colours
 180         (set-extent-property (make-extent (point-min) (1- (point)))
 181                      'face 'calendar-header-face))
 182     (calendar-insert-indented "" indent) ; Go to proper spot
 183     (calendar-for-loop
 184      i from 0 to 6 do
 185      (insert (substring (aref calendar-day-name-array
 186                               (mod (+ calendar-week-start-day i) 7)) 0 2))
 187      ;; Add colour to week day names and sundays
 188      (if calendar-use-colours
 189          (set-extent-property (make-extent  (- (point) 2) (point)) 'face
 190                       (if (= 0 (mod (+ calendar-week-start-day i) 7))
 191                           'calendar-sunday-face
 192                         'calendar-header-face)))
 193      (insert " "))
 194     ;; Add week-string after week dates
 195     (insert (concat calendar-week-string
 196                     (make-string (- 3 (length calendar-week-string)) ? )))
 197     ;; Add colour to week-string
 198     (if calendar-use-colours
 199         (set-extent-property (make-extent  (- (point) 3) (point))
 200                      'face 'calendar-week-face))
 201     (calendar-insert-indented "" 0 t);; Force onto following line
 202     (calendar-insert-indented "" indent);; Go to proper spot
 203     ;; Add blank days before the first of the month
 204     (calendar-for-loop i from 1 to blank-days do (insert "   "))
 205     ;; Put in the days of the month
 206     (calendar-for-loop
 207      i from 1 to last do
 208      (insert (format "%2d " i))
 209      (if (not calendar-use-colours)
 210          nil
 211        (put-text-property (- (point) 3) (1- (point)) 'mouse-face 'highlight)
 212        ;; Add colour to sunday
 213        (if (= 1 (mod (+ blank-days calendar-week-start-day i) 7))
 214            (set-extent-property (make-extent  (- (point) 3) (1- (point)))
 215                         'face 'calendar-sunday-face)))
 216      (and (zerop (mod (+ i blank-days) 7))
 217           ;; Add ISO-week # at the end each week entry
 218           (not (insert
 219                 (format "%2d " (extract-calendar-month
 220                                 (calendar-iso-from-absolute
 221                                  (calendar-absolute-from-gregorian
 222                                   (list month i year)))))))
 223           ;; Add colour to week #
 224           (if calendar-use-colours
 225               (set-extent-property (make-extent  (- (point) 3) (1- (point)))
 226                            'face 'calendar-week-face)
 227             t)
 228           (/= i last)
 229           (calendar-insert-indented "" 0 t);; Force onto following line
 230           (calendar-insert-indented "" indent)))));; Go to proper spot
 231
 232 (defalias 'generate-calendar-month #'sy-generate-calendar-month)
 233
 234 ;:*=======================
 235 ;:* Hooks
 236 (add-hook 'diary-display-hook #'fancy-diary-display)
 237 (add-hook 'diary-hook #'appt-make-list)
 238 (add-hook 'list-diary-entries-hook
 239           #'(lambda ()
 240              (sort-diary-entries)
 241              (include-other-diary-files)))
 242 (add-hook 'mark-diary-entries-hook #'mark-included-diary-files)
 243 (add-hook 'today-visible-calendar-hook #'calendar-mark-today)
 244 (add-hook 'calendar-move-hook #'(lambda () (diary-view-entries 1)))
 245 (add-hook 'calendar-mode-hook
 246           #'(lambda ()
 247               (setq fancy-diary-font-lock-keywords
 248                     (fancy-diary-font-lock-keywords))))
 249
 250 ;:*=======================
 251 ;:* Appointments
 252 (require 'appt)
 253 (require 'balloon-help)
 254 (balloon-help-mode 1)
 255 (setq
 256  balloon-help-background "BlanchedAlmond"
 257  balloon-help-foreground "Black"
 258  display-time-24hr-format t
 259  display-time-day-and-date t
 260  display-time-no-mail-balloon "What! No mail? That can't be right."
 261  display-time-mail-balloon-show-gnus-group t
 262  display-time-mail-balloon-max-displayed 20
 263  display-time-mail-balloon-gnus-split-width 19
 264  display-time-mail-balloon-enhance-gnus-group
 265  '("private.*")
 266  display-time-mail-balloon-suppress-gnus-group
 267  '("\\(SPAM.*\\|returned\\.mail\\)"))
 268 (display-time)
 269 (appt-initialize)
 270 (setq
 271  appt-message-warning-time 30
 272  appt-display-format 'echo
 273  appt-audible t
 274  appt-display-mode-line t
 275  appt-announce-method 'appt-persistent-message-announce)
 276 (appt-activate 1)
 277 ;:*=======================
 278 ;:* Holidays
 279 (defvar displayed-month)
 280 (defvar displayed-year)
 281 (require 'holidays)
 282
 283 ;; First up, a slightly re-written easter-holiday function
 284 (defun sy-easter-holidays ()
 285   "List of dates related to Easter, as visible in calendar window.
 286 Ever-so-slightly modified to include the Easter Monday holiday."
 287  (if (and (> displayed-month 5) (not all-christian-calendar-holidays))
 288      nil;; Ash Wednesday, Good Friday, and Easter are not visible.
 289    (let* ((century (1+ (/ displayed-year 100)))
 290           (shifted-epact        ;; Age of moon for April 5...
 291            (% (+ 14 (* 11 (% displayed-year 19));;     ...by Nicaean rule
 292                  (-           ;; ...corrected for the Gregorian century rule
 293                   (/ (* 3 century) 4))
 294                  (/    ;; ...corrected for Metonic cycle inaccuracy.
 295                   (+ 5 (* 8 century)) 25)
 296                  (* 30 century));;              Keeps value positive.
 297               30))
 298           (adjusted-epact       ;;  Adjust for 29.5 day month.
 299            (if (or (= shifted-epact 0)
 300                    (and (= shifted-epact 1) (< 10 (% displayed-year 19))))
 301                (1+ shifted-epact)
 302              shifted-epact))
 303           (paschal-moon       ;; Day after the full moon on or after March 21.
 304            (- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
 305               adjusted-epact))
 306           (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
 307           (mandatory
 308            (list
 309             (list (calendar-gregorian-from-absolute abs-easter)
 310                   "Easter Sunday")
 311             (list (calendar-gregorian-from-absolute (- abs-easter 2))
 312                   "Good Friday")
 313             (list (calendar-gregorian-from-absolute (+ abs-easter 1))
 314                   "Easter Monday")
 315             (list (calendar-gregorian-from-absolute (- abs-easter 46))
 316                   "Ash Wednesday")
 317             (list (calendar-gregorian-from-absolute (- abs-easter 47))
 318                   "Shrove Tuesday \(Pancake Tuesday\)")))
 319           (optional
 320            (list
 321             (list (calendar-gregorian-from-absolute (- abs-easter 63))
 322                   "Septuagesima Sunday")
 323             (list (calendar-gregorian-from-absolute (- abs-easter 56))
 324                   "Sexagesima Sunday")
 325             (list (calendar-gregorian-from-absolute (- abs-easter 49))
 326                   "Shrove Sunday")
 327             (list (calendar-gregorian-from-absolute (- abs-easter 48))
 328                   "Shrove Monday")
 329             (list (calendar-gregorian-from-absolute (- abs-easter 14))
 330                   "Passion Sunday")
 331             (list (calendar-gregorian-from-absolute (- abs-easter 7))
 332                   "Palm Sunday")
 333             (list (calendar-gregorian-from-absolute (- abs-easter 3))
 334                   "Maundy Thursday")
 335             (list (calendar-gregorian-from-absolute (+ abs-easter 35))
 336                   "Rogation Sunday")
 337             (list (calendar-gregorian-from-absolute (+ abs-easter 39))
 338                   "Ascension Day")
 339             (list (calendar-gregorian-from-absolute (+ abs-easter 49))
 340                   "Pentecost (Whitsunday)")
 341             (list (calendar-gregorian-from-absolute (+ abs-easter 50))
 342                   "Whitmonday")
 343             (list (calendar-gregorian-from-absolute (+ abs-easter 56))
 344                   "Trinity Sunday")
 345             (list (calendar-gregorian-from-absolute (+ abs-easter 60))
 346                   "Corpus Christi")))
 347           (output-list
 348            (filter-visible-calendar-holidays mandatory)))
 349      (if all-christian-calendar-holidays
 350          (setq output-list
 351                (append
 352                 (filter-visible-calendar-holidays optional)
 353                 output-list)))
 354      output-list)))
 355
 356 ;; Get rid of all the Americanised holidays
 357 (setq
 358  christian-holidays nil
 359  hebrew-holidays nil
 360  islamic-holidays nil
 361  general-holidays nil
 362  local-holidays nil
 363  other-holidays nil)
 364
 365 ;; Set up standard Aussie holidays
 366 (setq calendar-holidays
 367       '((holiday-fixed 1 1 "New Year's Day")
 368         ;; If New Year's day is on a weekend the public
 369         ;; holiday is the following Monday
 370         (if (or (eq 0 (calendar-day-of-week (list 1 1 displayed-year)))
 371                 (eq 6 (calendar-day-of-week (list 1 1 displayed-year))))
 372             (holiday-float 1 1 1 "New Year's Day Public Holiday"))
 373         (holiday-fixed 1 26 "Australia Day")
 374         ;; If Australia Day falls on a weekend, the
 375         ;; holiday is the following Monday
 376         (if (eq 0 (calendar-day-of-week (list 1 26 displayed-year)))
 377             (holiday-fixed 1 27 "Australia Day Public Holiday"))
 378         (if (eq 6 (calendar-day-of-week (list 1 26 displayed-year)))
 379             (holiday-fixed 1 28 "Australia Day Public Holiday"))
 380         (holiday-fixed 2 14 "Valentine's Day")
 381         (holiday-fixed 3 17 "St. Patrick's Day")
 382         (holiday-fixed 4 1 "April Fools' Day")
 383         (holiday-fixed 4 25 "Anzac Day")
 384         ;; If Anzac Day falls on a weekend, the holiday
 385         ;; is the following Monday
 386         (if (eq 0 (calendar-day-of-week (list 4 25 displayed-year)))
 387             (holiday-fixed 4 26 "Anzac Day Public Holiday"))
 388         (if (eq 6 (calendar-day-of-week (list 4 25 displayed-year)))
 389             (holiday-fixed 4 27 "Anzac Day Public Holiday"))
 390         (holiday-float 5 1 1 "Labour Day")
 391         (holiday-float 5 0 2 "Mother's Day")
 392         (holiday-float 6 1 2 "Queen's Birthday")
 393         ;; Brisbane Ekka holiday is on the 2nd Wednesday
 394         ;; in August, unless there are 5 Wednesdays in
 395         ;; August, then it is the 3rd Wednesday.
 396         (if (eq 8 (car (calendar-nth-named-day 5 3 8 displayed-year)))
 397             (holiday-float 8 3 3 "Brisbane Show Day")
 398           (holiday-float 8 3 2 "Brisbane Show Day"))
 399         (holiday-float 9 0 1 "Father's Day")
 400         (holiday-fixed 12 25 "Christmas Day")
 401         (holiday-fixed 12 26 "Boxing Day")
 402         ;; If Xmas falls on weekend, the public holiday
 403         ;; is the following Mon/Tue
 404         (if (or (eq 0 (calendar-day-of-week (list 12 25 displayed-year)))
 405                 (eq 6 (calendar-day-of-week (list 12 25 displayed-year))))
 406             (holiday-fixed 12 27 "Xmas Day Public Holiday"))
 407         (if (or (eq 0 (calendar-day-of-week (list 12 26 displayed-year)))
 408                 (eq 6 (calendar-day-of-week (list 12 26 displayed-year))))
 409             (holiday-fixed 12 28 "Boxing Day Public Holiday"))
 410         (solar-equinoxes-solstices)
 411         (sy-easter-holidays)))
 412 (setq mark-holidays-in-calendar t)
 413
 414 ;:*=======================
 415 ;:* Howm integration
 416 (setq
 417  calendar-date-display-form
 418  '("[" year "-" (format "%02d" (string-to-int month))
 419    "-" (format "%02d" (string-to-int day)) "] "
 420    (if dayname (concat dayname ", ")) day " " monthname " " year))
 421
 422 (defun howm-mark-calendar-date ()
 423   (interactive)
 424   (let* ((howm-schedule-types
 425           howm-schedule-menu-types)
 426          (raw (howm-reminder-search
 427                howm-schedule-types))
 428          (str nil) (yy nil) (mm nil) (dd nil))
 429     (while raw
 430       (setq str (nth 1 (car raw)))
 431       (when
 432           (string-match
 433            "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)"
 434            str)
 435         (setq yy (match-string 1 str))
 436         (setq mm (match-string 2 str))
 437         (setq dd (match-string 3 str)))
 438       (when (and yy mm dd)
 439         (mark-calendar-date-pattern
 440          (string-to-int mm)
 441          (string-to-int dd)
 442          (string-to-int yy)))
 443       (setq mm nil)
 444       (setq dd nil)
 445       (setq yy nil)
 446       (setq raw (cdr raw)))))
 447
 448 (defadvice mark-diary-entries
 449   (after mark-howm-entry activate)
 450   (howm-mark-calendar-date))
 451
 452 (and-boundp 'howm-menu-display-rules
 453   (setq
 454    howm-menu-display-rules
 455    (cons
 456     (cons "%hdiary[\n]?" 'howm-menu-diary)
 457     howm-menu-display-rules)))
 458
 459 (defun howm-menu-diary ()
 460   (message "scanning diary...")
 461   (delete-region
 462    (match-beginning 0) (match-end 0))
 463   (let* ((now (decode-time (current-time)))
 464          (diary-date
 465           (list (nth 4 now) (nth 3 now) (nth 5 now)))
 466          (diary-display-hook 'ignore)
 467          (howm-diary-entry nil)
 468          (howm-diary-entry-day nil)
 469          (str nil)
 470          yy mm dd)
 471     (unwind-protect
 472         (setq howm-diary-entry
 473               (diary-list-entries
 474                diary-date howm-menu-schedule-days))
 475       (save-excursion
 476         (set-buffer
 477          (find-buffer-visiting diary-file))
 478         (subst-char-in-region
 479          (point-min) (point-max) ?\^M ?\n t)
 480         (setq selective-display nil)))
 481     (while howm-diary-entry
 482       (setq howm-diary-entry-day (car howm-diary-entry))
 483       (setq mm (nth 0 (car howm-diary-entry-day)))
 484       (setq dd (nth 1 (car howm-diary-entry-day)))
 485       (setq yy (nth 2 (car howm-diary-entry-day)))
 486       (setq str (nth 1 howm-diary-entry-day))
 487       (setq howm-diary-entry (cdr howm-diary-entry))
 488       (insert
 489        (format
 490         ">>d [%04d-%02d-%02d] %s\n" yy mm dd str))))
 491   (message "scanning diary...done"))
 492
 493 (setq diary-date-forms
 494       '((month "/" day "[^/0-9]")
 495         (month "/" day "/" year "[^0-9]")
 496         ("\\[" year "-" month "-" day "\\]" "[^0-9]")
 497         (monthname " *" day "[^,0-9]")
 498         (monthname " *" day ", *" year "[^0-9]")
 499         (dayname "\\W")))
 500
 501 (defun howm-open-diary (&optional dummy)
 502   (interactive)
 503   (let ((date-str nil) (str nil))
 504     (save-excursion
 505       (beginning-of-line)
 506       (when (re-search-forward
 507              ">>d \\(\\[[-0-9]+\\]\\) " nil t)
 508         (setq str
 509               (concat
 510                "^.+"
 511                (buffer-substring-no-properties
 512                 (point) (line-end-position))))
 513         (setq date-str
 514               (concat
 515                "^.+"
 516                (buffer-substring-no-properties
 517                 (match-beginning 1)
 518                 (match-end 1))
 519                " " str))
 520         (find-file
 521          (substitute-in-file-name diary-file))
 522         (howm-mode t)
 523         (goto-char (point-min))
 524         (if (re-search-forward date-str nil t)
 525             ()
 526           (re-search-forward str nil t))))))
 527
 528 (defun add-diary-action-lock-rule ()
 529   (let ((rule
 530          (action-lock-general
 531           'howm-open-diary
 532           "^\\(>>d\\) "
 533           1 1)))
 534     (if (not (member rule action-lock-default-rules))
 535         (progn
 536           (setq action-lock-default-rules
 537                 (cons rule action-lock-default-rules))
 538           (action-lock-set-rules
 539            action-lock-default-rules)))))
 540
 541 (add-hook 'action-lock-mode-on-hook
 542           'add-diary-action-lock-rule)
 543
 544 (defadvice make-diary-entry
 545   (after howm-mode activate)
 546   (text-mode)
 547   (howm-mode t))
 548
 549 ;;; ;;;;;;;;;;
 550
 551 ;;; ;; M-x calendar, move cursor to a certain date, and
 552 ;;; ;; M-x howm-from-calendar to search that date in howm notes.
 553 (defun howm-from-calendar ()
 554   (interactive)
 555   (let* ((mdy (calendar-cursor-to-date t))
 556          (m (car mdy))
 557          (d (second mdy))
 558          (y (third mdy))
 559          (key (format-time-string
 560                howm-date-format
 561                (encode-time 0 0 0 d m y))))
 562     (howm-keyword-search key)))
 563
 564 ;; Bind howm-from-calendar to "H-d" key.
 565 (add-hook 'initial-calendar-window-hook
 566           #'(lambda ()
 567             (local-set-key [(hyper ?d)] 'howm-from-calendar)))
 568
 569
 570
 571 ;; Type "H-d" in howm menu to open calendar.
 572 (add-hook 'howm-menu-hook
 573           #'(lambda ()
 574             (local-set-key [(hyper ?d)] 'calendar)))
 575
 576 ;:*=======================
 577 ;:* Get the show on the road
 578 (defun sy-calendar-setup ()
 579   (mark-diary-entries)
 580   (mark-calendar-holidays)
 581   (diary-show-all-entries))
 582
 583 (add-hook 'calendar-load-hook 'sy-calendar-setup)
 584 ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
 585 (message "Calendar settings loaded")