cgit.sxemacs.org Git - website/blob - SYinits/11-cal.html

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