(require 'cedet-compat)
(require 'diary-lib)
(setq
calendar-latitude -27.47
calendar-longitude 153.02
calendar-location-name "Brisbane"
calendar-time-zone 600
cal-tex-diary t
calendar-time-display-form
'(24-hours ":" minutes
(if time-zone " (") time-zone (if time-zone ")"))
calendar-week-start-day 1
diary-file (expand-file-name "diary" user-init-directory)
diary-mail-addr "steve"
diary-mail-days 7
european-calendar-style t
mark-diary-entries-in-calendar t
number-of-diary-entries 7
view-diary-entries-initially t)
(setq calendar-and-diary-frame-parameters
'((name . "Calendar")
(title . "Calendar")
(height . 40)
(width . 80)
(minibuffer . t)
(default-toolbar-visible-p . nil)
(default-gutter-visible-p . nil)
(menubar-visible-p . t))
calendar-setup 'one-frame)
(defun sy-hide-fancy-dashes ()
"Hides the long lines of dashes from todo-mode in fancy diary display."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "-----" nil t)
(set-extent-property
(make-extent (match-beginning 0) (1+ (match-end 0)))
'invisible t))))
(define-derived-mode fancy-diary-display-mode fundamental-mode "Diary"
"Minor mode for displaying Fancy Diary entries buffer."
(set (make-local-variable 'font-lock-defaults)
'(fancy-diary-font-lock-keywords t))
(sy-hide-fancy-dashes)
(font-lock-mode)
(define-key (current-local-map) "o" 'other-window)
(define-key (current-local-map) [space] 'scroll-up-command)
(define-key (current-local-map) [backspace] 'scroll-down-command))
(defadvice fancy-diary-display (after set-mode activate)
"Give the Fancy Diary Entries buffer a mode of its own.
It has the ever-so-original name of: `fancy-diary-display-mode', adds
a couple of motion keybindings, and lets you set up font lock keywords
for a fontified Diary buffer."
(save-excursion
(set-buffer (get-buffer-create fancy-diary-buffer))
(fancy-diary-display-mode)))
(defun fancy-diary-font-lock-keywords ()
(let* ((today (regexp-opt (list (calendar-date-string (calendar-current-date)))))
(keywords `(("^---\\s-\\(.*$\\)" (1 font-lock-function-name-face))
("^.*SY:" . font-lock-keyword-face)
("\"\\(.*\\)\"" (1 font-lock-string-face))
("`\\(.*?\\)'" (1 font-lock-reference-face))
("[0-9]+:[0-9]+" . font-lock-warning-face)
(,today . font-lock-warning-face)
("\\(^.*\\)\n=" (1 font-lock-comment-face)))))
keywords))
(defvar fancy-diary-font-lock-keywords (fancy-diary-font-lock-keywords))
(require 'cal-iso)
(defvar calendar-use-colours t
"Tries to fontify Calendar if non-nil.")
(defvar calendar-week-string "WK"
"String (up to three chars) used in calendar header to identify week numbers.")
(defun sy-generate-calendar-month (month year indent)
"Produce a calendar for ISO-week, month, year on the Gregorian calendar.
The calendar is inserted in the buffer starting at the line on which point
is currently located, but indented INDENT spaces. The indentation is done
from the first character on the line and does not disturb the first INDENT
characters on the line."
(let* ((blank-days (mod
(- (calendar-day-of-week (list month 1 year))
calendar-week-start-day)
7))
(last (calendar-last-day-of-month month year)))
(goto-char (point-min))
(calendar-insert-indented
(calendar-string-spread
(list (format "%s %d" (calendar-month-name month) year)) ? 20)
indent t)
(if calendar-use-colours
(set-extent-property (make-extent (point-min) (1- (point)))
'face 'calendar-header-face))
(calendar-insert-indented "" indent) (calendar-for-loop
i from 0 to 6 do
(insert (substring (aref calendar-day-name-array
(mod (+ calendar-week-start-day i) 7)) 0 2))
(if calendar-use-colours
(set-extent-property (make-extent (- (point) 2) (point)) 'face
(if (= 0 (mod (+ calendar-week-start-day i) 7))
'calendar-sunday-face
'calendar-header-face)))
(insert " "))
(insert (concat calendar-week-string
(make-string (- 3 (length calendar-week-string)) ? )))
(if calendar-use-colours
(set-extent-property (make-extent (- (point) 3) (point))
'face 'calendar-week-face))
(calendar-insert-indented "" 0 t) (calendar-insert-indented "" indent) (calendar-for-loop i from 1 to blank-days do (insert " "))
(calendar-for-loop
i from 1 to last do
(insert (format "%2d " i))
(if (not calendar-use-colours)
nil
(put-text-property (- (point) 3) (1- (point)) 'mouse-face 'highlight)
(if (= 1 (mod (+ blank-days calendar-week-start-day i) 7))
(set-extent-property (make-extent (- (point) 3) (1- (point)))
'face 'calendar-sunday-face)))
(and (zerop (mod (+ i blank-days) 7))
(not (insert
(format "%2d " (extract-calendar-month
(calendar-iso-from-absolute
(calendar-absolute-from-gregorian
(list month i year)))))))
(if calendar-use-colours
(set-extent-property (make-extent (- (point) 3) (1- (point)))
'face 'calendar-week-face)
t)
(/= i last)
(calendar-insert-indented "" 0 t) (calendar-insert-indented "" indent)))))
(defalias 'generate-calendar-month #'sy-generate-calendar-month)
(add-hook 'diary-display-hook #'fancy-diary-display)
(add-hook 'diary-hook #'appt-make-list)
(add-hook 'list-diary-entries-hook
#'(lambda ()
(sort-diary-entries)
(include-other-diary-files)))
(add-hook 'mark-diary-entries-hook #'mark-included-diary-files)
(add-hook 'today-visible-calendar-hook #'calendar-mark-today)
(add-hook 'calendar-move-hook #'(lambda () (diary-view-entries 1)))
(add-hook 'calendar-mode-hook
#'(lambda ()
(setq fancy-diary-font-lock-keywords
(fancy-diary-font-lock-keywords))))
(defvar displayed-month)
(defvar displayed-year)
(require 'holidays)
(defun sy-easter-holidays ()
"List of dates related to Easter, as visible in calendar window.
Ever-so-slightly modified to include the Easter Monday holiday."
(if (and (> displayed-month 5) (not all-christian-calendar-holidays))
nil (let* ((century (1+ (/ displayed-year 100)))
(shifted-epact (% (+ 14 (* 11 (% displayed-year 19)) (- (/ (* 3 century) 4))
(/ (+ 5 (* 8 century)) 25)
(* 30 century)) 30))
(adjusted-epact (if (or (= shifted-epact 0)
(and (= shifted-epact 1) (< 10 (% displayed-year 19))))
(1+ shifted-epact)
shifted-epact))
(paschal-moon (- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
adjusted-epact))
(abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
(mandatory
(list
(list (calendar-gregorian-from-absolute abs-easter)
"Easter Sunday")
(list (calendar-gregorian-from-absolute (- abs-easter 2))
"Good Friday")
(list (calendar-gregorian-from-absolute (+ abs-easter 1))
"Easter Monday")
(list (calendar-gregorian-from-absolute (- abs-easter 46))
"Ash Wednesday")
(list (calendar-gregorian-from-absolute (- abs-easter 47))
"Shrove Tuesday \(Pancake Tuesday\)")))
(optional
(list
(list (calendar-gregorian-from-absolute (- abs-easter 63))
"Septuagesima Sunday")
(list (calendar-gregorian-from-absolute (- abs-easter 56))
"Sexagesima Sunday")
(list (calendar-gregorian-from-absolute (- abs-easter 49))
"Shrove Sunday")
(list (calendar-gregorian-from-absolute (- abs-easter 48))
"Shrove Monday")
(list (calendar-gregorian-from-absolute (- abs-easter 14))
"Passion Sunday")
(list (calendar-gregorian-from-absolute (- abs-easter 7))
"Palm Sunday")
(list (calendar-gregorian-from-absolute (- abs-easter 3))
"Maundy Thursday")
(list (calendar-gregorian-from-absolute (+ abs-easter 35))
"Rogation Sunday")
(list (calendar-gregorian-from-absolute (+ abs-easter 39))
"Ascension Day")
(list (calendar-gregorian-from-absolute (+ abs-easter 49))
"Pentecost (Whitsunday)")
(list (calendar-gregorian-from-absolute (+ abs-easter 50))
"Whitmonday")
(list (calendar-gregorian-from-absolute (+ abs-easter 56))
"Trinity Sunday")
(list (calendar-gregorian-from-absolute (+ abs-easter 60))
"Corpus Christi")))
(output-list
(filter-visible-calendar-holidays mandatory)))
(if all-christian-calendar-holidays
(setq output-list
(append
(filter-visible-calendar-holidays optional)
output-list)))
output-list)))
(setq
christian-holidays nil
hebrew-holidays nil
islamic-holidays nil
general-holidays nil
local-holidays nil
oriental-holidays nil
other-holidays nil)
(setq calendar-holidays
'((holiday-fixed 1 1 "New Year's Day")
(if (or (eq 0 (calendar-day-of-week (list 1 1 displayed-year)))
(eq 6 (calendar-day-of-week (list 1 1 displayed-year))))
(holiday-float 1 1 1 "New Year's Day Public Holiday"))
(holiday-fixed 1 26 "Australia Day")
(if (eq 0 (calendar-day-of-week (list 1 26 displayed-year)))
(holiday-fixed 1 27 "Australia Day Public Holiday"))
(if (eq 6 (calendar-day-of-week (list 1 26 displayed-year)))
(holiday-fixed 1 28 "Australia Day Public Holiday"))
(holiday-fixed 2 14 "Valentine's Day")
(holiday-fixed 3 17 "St. Patrick's Day")
(holiday-fixed 4 1 "April Fools' Day")
(holiday-fixed 4 25 "Anzac Day")
(if (eq 0 (calendar-day-of-week (list 4 25 displayed-year)))
(holiday-fixed 4 26 "Anzac Day Public Holiday"))
(if (eq 6 (calendar-day-of-week (list 4 25 displayed-year)))
(holiday-fixed 4 27 "Anzac Day Public Holiday"))
(holiday-float 5 1 1 "Labour Day")
(holiday-float 5 0 2 "Mother's Day")
(holiday-float 6 1 2 "Queen's Birthday")
(if (eq 8 (car (calendar-nth-named-day 5 3 8 displayed-year)))
(holiday-float 8 3 3 "Brisbane Show Day")
(holiday-float 8 3 2 "Brisbane Show Day"))
(holiday-float 9 0 1 "Father's Day")
(holiday-fixed 12 25 "Christmas Day")
(holiday-fixed 12 26 "Boxing Day")
(if (or (eq 0 (calendar-day-of-week (list 12 25 displayed-year)))
(eq 6 (calendar-day-of-week (list 12 25 displayed-year))))
(holiday-fixed 12 27 "Xmas Day Public Holiday"))
(if (or (eq 0 (calendar-day-of-week (list 12 26 displayed-year)))
(eq 6 (calendar-day-of-week (list 12 26 displayed-year))))
(holiday-fixed 12 28 "Boxing Day Public Holiday"))
(solar-equinoxes-solstices)
(sy-easter-holidays)))
(setq mark-holidays-in-calendar t)
(require 'appt)
(require 'balloon-help)
(balloon-help-mode 1)
(setq
balloon-help-background "BlanchedAlmond"
balloon-help-foreground "Black"
display-time-24hr-format t
display-time-day-and-date t
display-time-no-mail-balloon "What! No mail? That can't be right."
display-time-mail-balloon-show-gnus-group t
display-time-mail-balloon-max-displayed 20
display-time-mail-balloon-gnus-split-width 19
display-time-mail-balloon-enhance-gnus-group
'("private.*")
display-time-mail-balloon-suppress-gnus-group
'("\\(SPAM.*\\|returned\\.mail\\)"))
(display-time)
(appt-activate 1)
(setq
appt-message-warning-time 30
appt-display-format 'echo
appt-audible t
appt-display-mode-line t
appt-announce-method 'appt-persistent-message-announce)
(add-hook 'appt-make-list-hook #'appt-included-diary-entries)
(appt-activate 1)
(setq
calendar-date-display-form
'("[" year "-" (format "%02d" (string-to-int month))
"-" (format "%02d" (string-to-int day)) "] "
(if dayname (concat dayname ", ")) day " " monthname " " year))
(defun howm-mark-calendar-date ()
(interactive)
(let* ((howm-schedule-types
howm-schedule-menu-types)
(raw (howm-reminder-search
howm-schedule-types))
(str nil) (yy nil) (mm nil) (dd nil))
(while raw
(setq str (nth 1 (car raw)))
(when
(string-match
"\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)"
str)
(setq yy (match-string 1 str))
(setq mm (match-string 2 str))
(setq dd (match-string 3 str)))
(when (and yy mm dd)
(mark-calendar-date-pattern
(string-to-int mm)
(string-to-int dd)
(string-to-int yy)))
(setq mm nil)
(setq dd nil)
(setq yy nil)
(setq raw (cdr raw)))))
(defadvice mark-diary-entries
(after mark-howm-entry activate)
(howm-mark-calendar-date))
(and-boundp 'howm-menu-display-rules
(setq
howm-menu-display-rules
(cons
(cons "%hdiary[\n]?" 'howm-menu-diary)
howm-menu-display-rules)))
(defun howm-menu-diary ()
(message "scanning diary...")
(delete-region
(match-beginning 0) (match-end 0))
(let* ((now (decode-time (current-time)))
(diary-date
(list (nth 4 now) (nth 3 now) (nth 5 now)))
(diary-display-hook 'ignore)
(howm-diary-entry nil)
(howm-diary-entry-day nil)
(str nil)
yy mm dd)
(unwind-protect
(setq howm-diary-entry
(diary-list-entries
diary-date howm-menu-schedule-days))
(save-excursion
(set-buffer
(find-buffer-visiting diary-file))
(subst-char-in-region
(point-min) (point-max) ?\^M ?\n t)
(setq selective-display nil)))
(while howm-diary-entry
(setq howm-diary-entry-day (car howm-diary-entry))
(setq mm (nth 0 (car howm-diary-entry-day)))
(setq dd (nth 1 (car howm-diary-entry-day)))
(setq yy (nth 2 (car howm-diary-entry-day)))
(setq str (nth 1 howm-diary-entry-day))
(setq howm-diary-entry (cdr howm-diary-entry))
(insert
(format
">>d [%04d-%02d-%02d] %s\n" yy mm dd str))))
(message "scanning diary...done"))
(setq diary-date-forms
'((month "/" day "[^/0-9]")
(month "/" day "/" year "[^0-9]")
("\\[" year "-" month "-" day "\\]" "[^0-9]")
(monthname " *" day "[^,0-9]")
(monthname " *" day ", *" year "[^0-9]")
(dayname "\\W")))
(defun howm-open-diary (&optional dummy)
(interactive)
(let ((date-str nil) (str nil))
(save-excursion
(beginning-of-line)
(when (re-search-forward
">>d \\(\\[[-0-9]+\\]\\) " nil t)
(setq str
(concat
"^.+"
(buffer-substring-no-properties
(point) (line-end-position))))
(setq date-str
(concat
"^.+"
(buffer-substring-no-properties
(match-beginning 1)
(match-end 1))
" " str))
(find-file
(substitute-in-file-name diary-file))
(howm-mode t)
(goto-char (point-min))
(if (re-search-forward date-str nil t)
()
(re-search-forward str nil t))))))
(defun add-diary-action-lock-rule ()
(let ((rule
(action-lock-general
'howm-open-diary
"^\\(>>d\\) "
1 1)))
(if (not (member rule action-lock-default-rules))
(progn
(setq action-lock-default-rules
(cons rule action-lock-default-rules))
(action-lock-set-rules
action-lock-default-rules)))))
(add-hook 'action-lock-mode-on-hook
'add-diary-action-lock-rule)
(defadvice make-diary-entry
(after howm-mode activate)
(text-mode)
(howm-mode t))
(defun howm-from-calendar ()
(interactive)
(let* ((mdy (calendar-cursor-to-date t))
(m (car mdy))
(d (second mdy))
(y (third mdy))
(key (format-time-string
howm-date-format
(encode-time 0 0 0 d m y))))
(howm-keyword-search key)))
(add-hook 'initial-calendar-window-hook
#'(lambda ()
(local-set-key [(hyper ?d)] 'howm-from-calendar)))
(add-hook 'howm-menu-hook
#'(lambda ()
(local-set-key [(hyper ?d)] 'calendar)))
(define-key ctl-x-map "ti" 'timeclock-in)
(define-key ctl-x-map "to" 'timeclock-out)
(define-key ctl-x-map "tc" 'timeclock-change)
(define-key ctl-x-map "tr" 'timeclock-reread-log)
(define-key ctl-x-map "tu" 'timeclock-update-modeline)
(define-key ctl-x-map "tw" 'timeclock-when-to-leave-string)
(run-at-time "00:01" 86400 #'redraw-calendar)
(defun sy-calendar-setup ()
(mark-diary-entries)
(mark-calendar-holidays)
(diary-show-all-entries))
(add-hook 'calendar-load-hook 'sy-calendar-setup)
(message "Calendar settings loaded")
Copyright © 2020 Steve Youngs
Verbatim copying and distribution is permitted in any medium,
providing this notice is preserved.
Last modified: Wed Apr 15 18:14:11 AEST 2020