Add HTML versions of my init files
[website] / 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>