(or transient-mark-mode (setq transient-mark-mode 'only))
(set-mark (mark t)))))
-;; Functions for sexp diary entries.
-
-(defvar mdw-diary-for-org-mode-p nil
- "Display diary along with the agenda?")
-
-(defun mdw-not-org-mode (form)
- "As FORM, but not in Org mode agenda."
- (and (not mdw-diary-for-org-mode-p)
- (eval form)))
-
-(defun mdw-weekday (l)
- "Return non-nil if `date' falls on one of the days of the week in L.
-L is a list of day numbers (from 0 to 6 for Sunday through to
-Saturday) or symbols `sunday', `monday', etc. (or a mixture). If
-the date stored in `date' falls on a listed day, then the
-function returns non-nil."
- (let ((d (calendar-day-of-week date)))
- (or (memq d l)
- (memq (nth d '(sunday monday tuesday wednesday
- thursday friday saturday)) l))))
-
-(defun mdw-discordian-date (date)
- "Return the Discordian calendar date corresponding to DATE.
-
-The return value is (YOLD . st-tibs-day) or (YOLD SEASON DAYNUM DOW).
-
-The original is by David Pearson. I modified it to produce date components
-as output rather than a string."
- (let* ((days ["Sweetmorn" "Boomtime" "Pungenday"
- "Prickle-Prickle" "Setting Orange"])
- (months ["Chaos" "Discord" "Confusion"
- "Bureaucracy" "Aftermath"])
- (day-count [0 31 59 90 120 151 181 212 243 273 304 334])
- (year (- (calendar-extract-year date) 1900))
- (month (1- (calendar-extract-month date)))
- (day (1- (calendar-extract-day date)))
- (julian (+ (aref day-count month) day))
- (dyear (+ year 3066)))
- (if (and (= month 1) (= day 28))
- (cons dyear 'st-tibs-day)
- (list dyear
- (aref months (floor (/ julian 73)))
- (1+ (mod julian 73))
- (aref days (mod julian 5))))))
-
-(defun mdw-diary-discordian-date ()
- "Convert the date in `date' to a string giving the Discordian date."
- (let* ((ddate (mdw-discordian-date date))
- (tail (format "in the YOLD %d" (car ddate))))
- (if (eq (cdr ddate) 'st-tibs-day)
- (format "St Tib's Day %s" tail)
- (let ((season (cadr ddate))
- (daynum (cl-caddr ddate))
- (dayname (cl-cadddr ddate)))
- (format "%s, the %d%s day of %s %s"
- dayname
- daynum
- (let ((ldig (mod daynum 10)))
- (cond ((= ldig 1) "st")
- ((= ldig 2) "nd")
- ((= ldig 3) "rd")
- (t "th")))
- season
- tail)))))
-
-(defun mdw-todo (&optional when)
- "Return non-nil today, or on WHEN, whichever is later."
- (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
- (d (calendar-absolute-from-gregorian date)))
- (if when
- (setq w (max w (calendar-absolute-from-gregorian
- (cond
- ((not european-calendar-style)
- when)
- ((> (car when) 100)
- (list (nth 1 when)
- (nth 2 when)
- (nth 0 when)))
- (t
- (list (nth 1 when)
- (nth 0 when)
- (nth 2 when))))))))
- (eq w d)))
-
-(defcustom diary-time-regexp nil
- "Regexp matching times in the diary buffer."
- :type 'regexp)
-
-(defadvice diary-add-to-list (before mdw-trim-leading-space compile activate)
- "Trim leading space from the diary entry string."
- (save-match-data
- (let ((str (ad-get-arg 1))
- (done nil) old)
- (while (not done)
- (setq old str)
- (setq str (cond ((null str) nil)
- ((string-match "\\(^\\|\n\\)[ \t]+" str)
- (replace-match "\\1" nil nil str))
- ((and mdw-diary-for-org-mode-p
- (string-match (concat
- "\\(^\\|\n\\)"
- "\\(" diary-time-regexp
- "\\(-" diary-time-regexp "\\)?"
- "\\)"
- "\\(\t[ \t]*\\| [ \t]+\\)")
- str))
- (replace-match "\\1\\2 " nil nil str))
- ((and (not mdw-diary-for-org-mode-p)
- (string-match "\\[\\[[^][]*]\\[\\([^][]*\\)]]"
- str))
- (replace-match "\\1" nil nil str))
- (t str)))
- (if (equal str old) (setq done t)))
- (ad-set-arg 1 str))))
-
;; Glasses.
(setq glasses-separator "-"
display-buffer-pop-up-window
mdw-display-buffer-in-tolerable-window)))
+;;;--------------------------------------------------------------------------
+;;; Calendar and diary hacking.
+
+;; Functions for sexp diary entries.
+
+(defvar mdw-diary-for-org-mode-p nil
+ "Display diary along with the agenda?")
+
+(defun mdw-not-org-mode (form)
+ "As FORM, but not in Org mode agenda."
+ (and (not mdw-diary-for-org-mode-p)
+ (eval form)))
+
+(defun mdw-weekday (l)
+ "Return non-nil if `date' falls on one of the days of the week in L.
+L is a list of day numbers (from 0 to 6 for Sunday through to
+Saturday) or symbols `sunday', `monday', etc. (or a mixture). If
+the date stored in `date' falls on a listed day, then the
+function returns non-nil."
+ (let ((d (calendar-day-of-week date)))
+ (or (memq d l)
+ (memq (nth d '(sunday monday tuesday wednesday
+ thursday friday saturday)) l))))
+
+(defun mdw-discordian-date (date)
+ "Return the Discordian calendar date corresponding to DATE.
+
+The return value is (YOLD . st-tibs-day) or (YOLD SEASON DAYNUM DOW).
+
+The original is by David Pearson. I modified it to produce date components
+as output rather than a string."
+ (let* ((days ["Sweetmorn" "Boomtime" "Pungenday"
+ "Prickle-Prickle" "Setting Orange"])
+ (months ["Chaos" "Discord" "Confusion"
+ "Bureaucracy" "Aftermath"])
+ (day-count [0 31 59 90 120 151 181 212 243 273 304 334])
+ (year (- (calendar-extract-year date) 1900))
+ (month (1- (calendar-extract-month date)))
+ (day (1- (calendar-extract-day date)))
+ (julian (+ (aref day-count month) day))
+ (dyear (+ year 3066)))
+ (if (and (= month 1) (= day 28))
+ (cons dyear 'st-tibs-day)
+ (list dyear
+ (aref months (floor (/ julian 73)))
+ (1+ (mod julian 73))
+ (aref days (mod julian 5))))))
+
+(defun mdw-diary-discordian-date ()
+ "Convert the date in `date' to a string giving the Discordian date."
+ (let* ((ddate (mdw-discordian-date date))
+ (tail (format "in the YOLD %d" (car ddate))))
+ (if (eq (cdr ddate) 'st-tibs-day)
+ (format "St Tib's Day %s" tail)
+ (let ((season (cadr ddate))
+ (daynum (cl-caddr ddate))
+ (dayname (cl-cadddr ddate)))
+ (format "%s, the %d%s day of %s %s"
+ dayname
+ daynum
+ (let ((ldig (mod daynum 10)))
+ (cond ((= ldig 1) "st")
+ ((= ldig 2) "nd")
+ ((= ldig 3) "rd")
+ (t "th")))
+ season
+ tail)))))
+
+(defun mdw-todo (&optional when)
+ "Return non-nil today, or on WHEN, whichever is later."
+ (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
+ (d (calendar-absolute-from-gregorian date)))
+ (if when
+ (setq w (max w (calendar-absolute-from-gregorian
+ (cond
+ ((not european-calendar-style)
+ when)
+ ((> (car when) 100)
+ (list (nth 1 when)
+ (nth 2 when)
+ (nth 0 when)))
+ (t
+ (list (nth 1 when)
+ (nth 0 when)
+ (nth 2 when))))))))
+ (eq w d)))
+
+(defcustom diary-time-regexp nil
+ "Regexp matching times in the diary buffer."
+ :type 'regexp)
+
+(defadvice diary-add-to-list (before mdw-trim-leading-space compile activate)
+ "Trim leading space from the diary entry string."
+ (save-match-data
+ (let ((str (ad-get-arg 1))
+ (done nil) old)
+ (while (not done)
+ (setq old str)
+ (setq str (cond ((null str) nil)
+ ((string-match "\\(^\\|\n\\)[ \t]+" str)
+ (replace-match "\\1" nil nil str))
+ ((and mdw-diary-for-org-mode-p
+ (string-match (concat
+ "\\(^\\|\n\\)"
+ "\\(" diary-time-regexp
+ "\\(-" diary-time-regexp "\\)?"
+ "\\)"
+ "\\(\t[ \t]*\\| [ \t]+\\)")
+ str))
+ (replace-match "\\1\\2 " nil nil str))
+ ((and (not mdw-diary-for-org-mode-p)
+ (string-match "\\[\\[[^][]*]\\[\\([^][]*\\)]]"
+ str))
+ (replace-match "\\1" nil nil str))
+ (t str)))
+ (if (equal str old) (setq done t)))
+ (ad-set-arg 1 str))))
+
;;;--------------------------------------------------------------------------
;;; Org-mode hacking.
~mdw / profile / commitdiff