* Trying to cope with Calendar's dynamic scoping
@ 2013-08-20 22:07 Stefan Monnier
2013-08-21 0:19 ` Edward Reingold
` (3 more replies)
0 siblings, 4 replies; 14+ messages in thread
From: Stefan Monnier @ 2013-08-20 22:07 UTC (permalink / raw)
To: Glenn Morris; +Cc: Edward M. Reingold, emacs-devel
Could you look at the patch below to see if it might be workable?
I use Calendar but only in very simple ways, so this has been tested
only superficially.
What it does is basically to wrap all calls to `eval' so as to pass the
expected vars explicitly (so they're available in the evaluated
expressions as locally-bound lexical vars rather than as dynamically
scoped vars). It also moves some `eval' calls around (basically from
generic functions to their caller) so that the precise context of those
calls is known.
It also renames `date' and `entry' to `diary-date' and `diary-entry'
where dynamic scoping is used.
While I was there I fixed some ARGNAME vs `varname' inconsistencies.
And I turned a global boolean into a minor-mode, because it seemed to
work better (despite the name not being "foo-mode").
There are still some nasty dynamic scoping issues (most egregious is
`number'), but we can keep them around to be sure we still have work to
do, right?
Stefan
=== modified file 'lisp/calendar/cal-bahai.el'
--- lisp/calendar/cal-bahai.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-bahai.el 2013-08-20 21:44:15 +0000
@@ -128,8 +128,10 @@
(if (< y 1)
"" ; pre-Bahai
(let* ((m (calendar-extract-month bahai-date))
- (d (calendar-extract-day bahai-date))
- (monthname (if (and (= m 19)
+ (d (calendar-extract-day bahai-date)))
+ ;; Can't call calendar-date-string because of monthname oddity.
+ (calendar--evalconcat
+ ((monthname (if (and (= m 19)
(<= d 0))
"Ayyám-i-Há"
(aref calendar-bahai-month-name-array (1- m))))
@@ -139,9 +141,8 @@
d)))
(year (number-to-string y))
(month (number-to-string m))
- dayname)
- ;; Can't call calendar-date-string because of monthname oddity.
- (mapconcat 'eval calendar-date-display-form "")))))
+ (dayname nil))
+ calendar-date-display-form "")))))
;;;###cal-autoload
(defun calendar-bahai-print-date ()
@@ -269,7 +270,7 @@
`diary-nongregorian-listing-hook'."
(diary-list-entries-1 calendar-bahai-month-name-array
diary-bahai-entry-symbol
- 'calendar-bahai-from-absolute))
+ #'calendar-bahai-from-absolute))
(define-obsolete-function-alias
'list-bahai-diary-entries 'diary-bahai-list-entries "23.1")
@@ -345,13 +346,13 @@
(define-obsolete-function-alias
'insert-yearly-bahai-diary-entry 'diary-bahai-insert-yearly-entry "23.1")
-(defvar date)
+(defvar diary-date)
-;; To be called from diary-list-sexp-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-bahai-date ()
"Bahá'í calendar equivalent of date diary entry."
- (format "Bahá'í date: %s" (calendar-bahai-date-string date)))
+ (format "Bahá'í date: %s" (calendar-bahai-date-string diary-date)))
(provide 'cal-bahai)
=== modified file 'lisp/calendar/cal-china.el'
--- lisp/calendar/cal-china.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-china.el 2013-08-20 21:44:28 +0000
@@ -219,21 +219,22 @@
"Absolute date of first new Zodiac sign on or after absolute date D.
The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
(let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
- (calendar-time-zone (eval calendar-chinese-time-zone)) ; uses year
- (calendar-daylight-time-offset
- calendar-chinese-daylight-time-offset)
- (calendar-standard-time-zone-name
- calendar-chinese-standard-time-zone-name)
- (calendar-daylight-time-zone-name
- calendar-chinese-daylight-time-zone-name)
- (calendar-daylight-savings-starts
- calendar-chinese-daylight-saving-start)
- (calendar-daylight-savings-ends
- calendar-chinese-daylight-saving-end)
- (calendar-daylight-savings-starts-time
- calendar-chinese-daylight-saving-start-time)
- (calendar-daylight-savings-ends-time
- calendar-chinese-daylight-saving-end-time))
+ (calendar-time-zone (calendar--eval calendar-chinese-time-zone
+ ((year year))))
+ (calendar-daylight-time-offset
+ calendar-chinese-daylight-time-offset)
+ (calendar-standard-time-zone-name
+ calendar-chinese-standard-time-zone-name)
+ (calendar-daylight-time-zone-name
+ calendar-chinese-daylight-time-zone-name)
+ (calendar-daylight-savings-starts
+ calendar-chinese-daylight-saving-start)
+ (calendar-daylight-savings-ends
+ calendar-chinese-daylight-saving-end)
+ (calendar-daylight-savings-starts-time
+ calendar-chinese-daylight-saving-start-time)
+ (calendar-daylight-savings-ends-time
+ calendar-chinese-daylight-saving-end-time))
(floor
(calendar-astro-to-absolute
(solar-date-next-longitude (calendar-astro-from-absolute d) 30)))))
@@ -241,7 +242,8 @@
(defun calendar-chinese-new-moon-on-or-after (d)
"Absolute date of first new moon on or after absolute date D."
(let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
- (calendar-time-zone (eval calendar-chinese-time-zone))
+ (calendar-time-zone (calendar--eval calendar-chinese-time-zone
+ ((year year))))
(calendar-daylight-time-offset
calendar-chinese-daylight-time-offset)
(calendar-standard-time-zone-name
@@ -674,13 +676,13 @@
(define-obsolete-function-alias 'calendar-goto-chinese-date
'calendar-chinese-goto-date "23.1")
-(defvar date)
+(defvar diary-date)
-;; To be called from diary-list-sexp-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-chinese-date ()
"Chinese calendar equivalent of date diary entry."
- (format "Chinese date: %s" (calendar-chinese-date-string date)))
+ (format "Chinese date: %s" (calendar-chinese-date-string diary-date)))
(provide 'cal-china)
=== modified file 'lisp/calendar/cal-coptic.el'
--- lisp/calendar/cal-coptic.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-coptic.el 2013-08-20 21:41:36 +0000
@@ -119,12 +119,13 @@
(m (calendar-extract-month coptic-date)))
(if (< y 1)
""
- (let ((monthname (aref calendar-coptic-month-name-array (1- m)))
- (day (number-to-string (calendar-extract-day coptic-date)))
- (dayname nil)
- (month (number-to-string m))
- (year (number-to-string y)))
- (mapconcat 'eval calendar-date-display-form "")))))
+ (calendar--evalconcat
+ ((monthname (aref calendar-coptic-month-name-array (1- m)))
+ (day (number-to-string (calendar-extract-day coptic-date)))
+ (dayname nil)
+ (month (number-to-string m))
+ (year (number-to-string y)))
+ calendar-date-display-form ""))))
;;;###cal-autoload
(defun calendar-coptic-print-date ()
@@ -179,13 +180,13 @@
(define-obsolete-function-alias 'calendar-goto-coptic-date
'calendar-coptic-goto-date "23.1")
-(defvar date)
+(defvar diary-date)
-;; To be called from diary-list-sexp-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-coptic-date ()
"Coptic calendar equivalent of date diary entry."
- (let ((f (calendar-coptic-date-string date)))
+ (let ((f (calendar-coptic-date-string diary-date)))
(if (string-equal f "")
(format "Date is pre-%s calendar" calendar-coptic-name)
(format "%s date: %s" calendar-coptic-name f))))
=== modified file 'lisp/calendar/cal-dst.el'
--- lisp/calendar/cal-dst.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-dst.el 2013-08-20 18:32:22 +0000
@@ -183,6 +183,9 @@
(autoload 'calendar-persian-to-absolute "cal-persia")
+(defsubst calendar-dst--eval (year exp)
+ (calendar--eval exp ((year year))))
+
(defun calendar-time-zone-daylight-rules (abs-date utc-diff)
"Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from UTC.
ABS-DATE must specify a day that contains a daylight saving transition.
@@ -227,10 +230,12 @@
;; The rule we return should give a Gregorian date, but here
;; we require an absolute date. The following is for efficiency.
(setq date (cond ((eq (car rule) 'calendar-nth-named-day)
- (eval (cons 'calendar-nth-named-absday (cdr rule))))
+ (calendar-dst--eval
+ year (cons 'calendar-nth-named-absday (cdr rule))))
((eq (car rule) 'calendar-gregorian-from-absolute)
- (eval (cadr rule)))
- (t (calendar-absolute-from-gregorian (eval rule)))))
+ (calendar-dst--eval year (cadr rule)))
+ (t (calendar-absolute-from-gregorian
+ (calendar-dst--eval year rule)))))
(or (equal (current-time-zone
(calendar-time-from-absolute date prevday-sec))
(current-time-zone
@@ -404,7 +409,7 @@
(or (let ((expr (if calendar-dst-check-each-year-flag
(cadr (calendar-dst-find-startend year))
(nth 4 calendar-current-time-zone-cache))))
- (if expr (eval expr)))
+ (if expr (calendar-dst--eval year expr)))
;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/.
(and (not (zerop calendar-daylight-time-offset))
(calendar-nth-named-day 2 0 3 year))))
@@ -415,7 +420,7 @@
(or (let ((expr (if calendar-dst-check-each-year-flag
(nth 2 (calendar-dst-find-startend year))
(nth 5 calendar-current-time-zone-cache))))
- (if expr (eval expr)))
+ (if expr (calendar-dst--eval year expr)))
;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/.
(and (not (zerop calendar-daylight-time-offset))
(calendar-nth-named-day 1 0 11 year))))
@@ -426,8 +431,10 @@
Fractional part of DATE is local standard time of day."
(let* ((year (calendar-extract-year
(calendar-gregorian-from-absolute (floor date))))
- (dst-starts-gregorian (eval calendar-daylight-savings-starts))
- (dst-ends-gregorian (eval calendar-daylight-savings-ends))
+ (dst-starts-gregorian
+ (calendar-dst--eval year calendar-daylight-savings-starts))
+ (dst-ends-gregorian
+ (calendar-dst--eval year calendar-daylight-savings-ends))
(dst-starts (and dst-starts-gregorian
(+ (calendar-absolute-from-gregorian
dst-starts-gregorian)
=== modified file 'lisp/calendar/cal-french.el'
--- lisp/calendar/cal-french.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-french.el 2013-08-20 21:44:02 +0000
@@ -252,13 +252,13 @@
(define-obsolete-function-alias 'calendar-goto-french-date
'calendar-french-goto-date "23.1")
-(defvar date)
+(defvar diary-date)
-;; To be called from diary-list-sexp-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-french-date ()
"French calendar equivalent of date diary entry."
- (let ((f (calendar-french-date-string date)))
+ (let ((f (calendar-french-date-string diary-date)))
(if (string-equal f "")
"Date is pre-French Revolution"
(format "French Revolutionary date: %s" f))))
=== modified file 'lisp/calendar/cal-hebrew.el'
--- lisp/calendar/cal-hebrew.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-hebrew.el 2013-08-20 21:56:44 +0000
@@ -804,15 +804,16 @@
;; or the corresponding day in years without that date.
(+ (calendar-hebrew-to-absolute (list b-month 1 year)) b-day -1))))
-(defvar date)
+(defvar diary-date)
+(defvar diary-entry)
-;; To be called from diary-list-sexp-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-hebrew-date ()
"Hebrew calendar equivalent of date diary entry."
- (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
+ (format "Hebrew date (until sunset): %s"
+ (calendar-hebrew-date-string diary-date)))
-(defvar entry)
(declare-function diary-ordinal-suffix "diary-lib" (n))
;;;###diary-autoload
@@ -834,12 +835,12 @@
(diary-make-date month day year))
(if after-sunset 1 0))))
(h-year (calendar-extract-year h-date)) ; birth-day
- (d (calendar-absolute-from-gregorian date)) ; today
+ (d (calendar-absolute-from-gregorian diary-date)) ; today
(h-yr (calendar-extract-year (calendar-hebrew-from-absolute d)))
(age (- h-yr h-year)) ; current H year - birth H-year
(b-date (calendar-hebrew-birthday h-date h-yr)))
(and (> age 0) (memq b-date (list d (1+ d)))
- (format "%s's %d%s Hebrew birthday%s" entry age
+ (format "%s's %d%s Hebrew birthday%s" diary-entry age
(diary-ordinal-suffix age)
(if (= b-date d) "" " (evening)")))))
@@ -852,8 +853,8 @@
use when highlighting the day in the calendar."
(let* ((passover
(calendar-hebrew-to-absolute
- (list 1 15 (+ (calendar-extract-year date) 3760))))
- (omer (- (calendar-absolute-from-gregorian date) passover))
+ (list 1 15 (+ (calendar-extract-year diary-date) 3760))))
+ (omer (- (calendar-absolute-from-gregorian diary-date) passover))
(week (/ omer 7))
(day (% omer 7)))
(if (and (> omer 0) (< omer 50))
@@ -899,14 +900,14 @@
(diary-make-date death-month death-day death-year))
(if after-sunset 1 0))))
(h-year (calendar-extract-year h-date))
- (d (calendar-absolute-from-gregorian date))
+ (d (calendar-absolute-from-gregorian diary-date))
(yr (calendar-extract-year (calendar-hebrew-from-absolute d)))
(diff (- yr h-year))
(y (calendar-hebrew-yahrzeit h-date yr)))
(if (and (> diff 0) (or (= y d) (= y (1+ d))))
(cons mark
(format "Yahrzeit of %s%s: %d%s anniversary"
- entry
+ diary-entry
(if (= y d) "" " (evening)")
diff
(diary-ordinal-suffix diff))))))
@@ -921,7 +922,7 @@
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
- (let* ((d (calendar-absolute-from-gregorian date))
+ (let* ((d (calendar-absolute-from-gregorian diary-date))
(h-date (calendar-hebrew-from-absolute d))
(h-month (calendar-extract-month h-date))
(h-day (calendar-extract-day h-date))
@@ -1124,7 +1125,7 @@
"Parasha diary entry--entry applies if date is a Saturday.
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
- (let ((d (calendar-absolute-from-gregorian date)))
+ (let ((d (calendar-absolute-from-gregorian diary-date)))
(if (= (% d 7) 6) ; Saturday
(let* ((h-year (calendar-extract-year
(calendar-hebrew-from-absolute d)))
@@ -1188,8 +1189,8 @@
(require 'solar)
(or (and calendar-latitude calendar-longitude calendar-time-zone)
(solar-setup))
- (if (= (% (calendar-absolute-from-gregorian date) 7) 5) ; Friday
- (let ((sunset (cadr (solar-sunrise-sunset date))))
+ (if (= (% (calendar-absolute-from-gregorian diary-date) 7) 5) ; Friday
+ (let ((sunset (cadr (solar-sunrise-sunset diary-date))))
(if sunset
(cons mark (format
"%s Sabbath candle lighting"
=== modified file 'lisp/calendar/cal-html.el'
--- lisp/calendar/cal-html.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-html.el 2013-08-20 21:58:02 +0000
@@ -1,4 +1,4 @@
-;;; cal-html.el --- functions for printing HTML calendars
+;;; cal-html.el --- functions for printing HTML calendars -*- lexical-binding:t -*-
;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
=== modified file 'lisp/calendar/cal-islam.el'
--- lisp/calendar/cal-islam.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-islam.el 2013-08-20 21:43:29 +0000
@@ -66,8 +66,8 @@
"Absolute date of Islamic DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
- (let* ((month (calendar-extract-month date))
- (day (calendar-extract-day date))
+ (let* (;; (month (calendar-extract-month date))
+ ;; (day (calendar-extract-day date))
(year (calendar-extract-year date))
(y (% year 30))
(leap-years-in-cycle (cond ((< y 3) 0)
@@ -331,13 +331,13 @@
(define-obsolete-function-alias
'insert-yearly-islamic-diary-entry 'diary-islamic-insert-yearly-entry "23.1")
-(defvar date)
+(defvar diary-date)
-;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
+;; To be called from diary-sexp-entry, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-islamic-date ()
"Islamic calendar equivalent of date diary entry."
- (let ((i (calendar-islamic-date-string date)))
+ (let ((i (calendar-islamic-date-string diary-date)))
(if (string-equal i "")
"Date is pre-Islamic"
(format "Islamic date (until sunset): %s" i))))
=== modified file 'lisp/calendar/cal-iso.el'
--- lisp/calendar/cal-iso.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-iso.el 2013-08-20 19:26:43 +0000
@@ -144,13 +144,13 @@
(define-obsolete-function-alias 'calendar-goto-iso-week
'calendar-iso-goto-week "23.1")
-(defvar date)
+(defvar diary-date)
-;; To be called from diary-list-sexp-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-iso-date ()
"ISO calendar equivalent of date diary entry."
- (format "ISO date: %s" (calendar-iso-date-string date)))
+ (format "ISO date: %s" (calendar-iso-date-string diary-date)))
(provide 'cal-iso)
=== modified file 'lisp/calendar/cal-julian.el'
--- lisp/calendar/cal-julian.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-julian.el 2013-08-20 21:44:43 +0000
@@ -200,20 +200,20 @@
(define-obsolete-function-alias 'calendar-goto-astro-day-number
'calendar-astro-goto-day-number "23.1")
-(defvar date)
+(defvar diary-date)
-;; To be called from diary-list-sexp-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-julian-date ()
"Julian calendar equivalent of date diary entry."
- (format "Julian date: %s" (calendar-julian-date-string date)))
+ (format "Julian date: %s" (calendar-julian-date-string diary-date)))
-;; To be called from diary-list-sexp-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-astro-day-number ()
"Astronomical (Julian) day number diary entry."
(format "Astronomical (Julian) day number at noon UTC: %s.0"
- (calendar-astro-date-string date)))
+ (calendar-astro-date-string diary-date)))
(provide 'cal-julian)
=== modified file 'lisp/calendar/cal-mayan.el'
--- lisp/calendar/cal-mayan.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-mayan.el 2013-08-20 19:27:16 +0000
@@ -380,13 +380,13 @@
(define-obsolete-function-alias 'calendar-goto-mayan-long-count-date
'calendar-mayan-goto-long-count-date "23.1")
-(defvar date)
+(defvar diary-date)
-;; To be called from diary-list-sexp-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-mayan-date ()
"Show the Mayan long count, haab, and tzolkin dates as a diary entry."
- (format "Mayan date: %s" (calendar-mayan-date-string date)))
+ (format "Mayan date: %s" (calendar-mayan-date-string diary-date)))
(provide 'cal-mayan)
=== modified file 'lisp/calendar/cal-menu.el'
--- lisp/calendar/cal-menu.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-menu.el 2013-08-20 19:23:48 +0000
@@ -1,4 +1,4 @@
-;;; cal-menu.el --- calendar functions for menu bar and popup menu support
+;;; cal-menu.el --- calendar functions for menu bar and popup menu support -*- lexical-binding:t -*-
;; Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc.
@@ -99,9 +99,9 @@
;; The bug has since been fixed.
(dotimes (i 11)
(push (vector (format "hol-year-%d" i)
- `(lambda ()
- (interactive)
- (holiday-list (+ displayed-year ,(- i 5))))
+ (lambda ()
+ (interactive)
+ (holiday-list (+ displayed-year (- i 5))))
:label `(format "For Year %d"
(+ displayed-year ,(- i 5))))
l))
@@ -177,6 +177,7 @@
(autoload 'diary-list-entries "diary-lib")
;; Autoloaded in diary-lib.
(declare-function calendar-check-holidays "holidays" (date))
+(defvar diary-list-include-blanks) ;From diary-lib.
(defun calendar-mouse-view-diary-entries (&optional date diary event)
"Pop up menu of diary entries for mouse-selected date.
=== modified file 'lisp/calendar/cal-persia.el'
--- lisp/calendar/cal-persia.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-persia.el 2013-08-20 21:44:55 +0000
@@ -148,13 +148,14 @@
(calendar-absolute-from-gregorian
(or date (calendar-current-date)))))
(y (calendar-extract-year persian-date))
- (m (calendar-extract-month persian-date))
- (monthname (aref calendar-persian-month-name-array (1- m)))
+ (m (calendar-extract-month persian-date)))
+ (calendar--evalconcat
+ ((monthname (aref calendar-persian-month-name-array (1- m)))
(day (number-to-string (calendar-extract-day persian-date)))
(year (number-to-string y))
(month (number-to-string m))
- dayname)
- (mapconcat 'eval calendar-date-display-form "")))
+ (dayname nil))
+ calendar-date-display-form "")))
;;;###cal-autoload
(defun calendar-persian-print-date ()
@@ -207,13 +208,13 @@
(define-obsolete-function-alias 'calendar-goto-persian-date
'calendar-persian-goto-date "23.1")
-(defvar date)
+(defvar diary-date)
-;; To be called from diary-list-sexp-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-persian-date ()
"Persian calendar equivalent of date diary entry."
- (format "Persian date: %s" (calendar-persian-date-string date)))
+ (format "Persian date: %s" (calendar-persian-date-string diary-date)))
(provide 'cal-persia)
=== modified file 'lisp/calendar/cal-tex.el'
--- lisp/calendar/cal-tex.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/cal-tex.el 2013-08-20 19:21:33 +0000
@@ -1,4 +1,4 @@
-;;; cal-tex.el --- calendar functions for printing calendars with LaTeX
+;;; cal-tex.el --- calendar functions for printing calendars with LaTeX -*- lexical-binding:t -*-
;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc.
@@ -94,6 +94,8 @@
:group 'calendar-tex)
(defcustom cal-tex-daily-string
+ ;; FIXME: This should hold a function of one argument (the date) rather
+ ;; than an expression.
'(let* ((year (calendar-extract-year date))
(day (calendar-day-number date))
(days-remaining (- (calendar-day-number (list 12 31 year)) day)))
@@ -115,6 +117,11 @@
:type 'sexp
:group 'calendar-tex)
+(defsubst cal-tex-daily-string (date)
+ (if (functionp cal-tex-daily-string)
+ (funcall cal-tex-daily-string date)
+ (calendar--eval cal-tex-daily-string ((date date)))))
+
(defcustom cal-tex-buffer "calendar.tex"
"The name for the output LaTeX calendar buffer."
:type 'string
@@ -249,6 +256,7 @@
(define-obsolete-function-alias 'cal-tex-list-holidays 'holiday-in-range "24.3")
(autoload 'diary-list-entries "diary-lib")
+(defvar diary-list-include-blanks) ;From diary-lib as well.
(defun cal-tex-list-diary-entries (d1 d2)
"Generate a list of all diary-entries from absolute date D1 to D2."
@@ -586,7 +594,7 @@
(insert (format day-format (cal-tex-month-name month) j))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (cal-tex-daily-string date))
(cal-tex-arg)
(cal-tex-comment))
(when (and (zerop (mod (+ j blank-days) 7))
@@ -872,7 +880,7 @@
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
(month (calendar-extract-month date))
- (year (calendar-extract-year date))
+ ;; (year (calendar-extract-year date))
(day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
@@ -913,7 +921,7 @@
(insert ": ")
(cal-tex-large-bf s))
(cal-tex-hfill)
- (insert " " (eval cal-tex-daily-string))
+ (insert " " (cal-tex-daily-string date))
(cal-tex-e-parbox)
(cal-tex-nl)
(cal-tex-noindent)
@@ -932,7 +940,8 @@
(cal-tex-e-parbox "2cm")
(cal-tex-nl)
(setq month (calendar-extract-month date)
- year (calendar-extract-year date)))
+ ;; year (calendar-extract-year date)
+ ))
(cal-tex-e-parbox)
(unless (= i (1- n))
(run-hooks 'cal-tex-week-hook)
@@ -948,7 +957,7 @@
shown are hard-coded to 8-12, 13-17."
(let ((month (calendar-extract-month date))
(day (calendar-extract-day date))
- (year (calendar-extract-year date))
+ ;; (year (calendar-extract-year date))
morning afternoon s)
(cal-tex-comment "begin cal-tex-week-hours")
(cal-tex-cmd "\\ \\\\[-.2cm]")
@@ -964,7 +973,7 @@
(insert ": ")
(cal-tex-large-bf s))
(cal-tex-hfill)
- (insert " " (eval cal-tex-daily-string))
+ (insert " " (cal-tex-daily-string date))
(cal-tex-e-parbox)
(cal-tex-nl "-.3cm")
(cal-tex-rule "0pt" "6.8in" ".2mm")
@@ -1074,9 +1083,9 @@
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
- (month (calendar-extract-month date))
- (year (calendar-extract-year date))
- (day (calendar-extract-day date))
+ ;; (month (calendar-extract-month date))
+ ;; (year (calendar-extract-year date))
+ ;; (day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@@ -1142,7 +1151,7 @@
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (cal-tex-daily-string date))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
@@ -1196,7 +1205,7 @@
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (cal-tex-daily-string date))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(dotimes (_jdummy 2)
@@ -1205,7 +1214,7 @@
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (cal-tex-daily-string date))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(unless (= i (1- n))
@@ -1244,9 +1253,9 @@
calendar-week-start-day
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
- (month (calendar-extract-month date))
- (year (calendar-extract-year date))
- (day (calendar-extract-day date))
+ ;; (month (calendar-extract-month date))
+ ;; (year (calendar-extract-year date))
+ ;; (day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@@ -1292,7 +1301,7 @@
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (cal-tex-daily-string date))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(unless (= i (1- n))
@@ -1328,9 +1337,9 @@
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
- (month (calendar-extract-month date))
- (year (calendar-extract-year date))
- (day (calendar-extract-day date))
+ ;; (month (calendar-extract-month date))
+ ;; (year (calendar-extract-year date))
+ ;; (day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@@ -1364,7 +1373,7 @@
"\\leftday")))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (cal-tex-daily-string date))
(insert "%\n")
(if cal-tex-rules
(insert "\\linesfill\n")
@@ -1378,7 +1387,7 @@
(insert "\\weekend")
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (cal-tex-daily-string date))
(insert "%\n")
(if cal-tex-rules
(insert "\\linesfill\n")
@@ -1440,7 +1449,7 @@
(cal-tex-bf month-name )
(cal-tex-e-parbox)
(cal-tex-hspace "1cm")
- (cal-tex-scriptsize (eval cal-tex-daily-string))
+ (cal-tex-scriptsize (cal-tex-daily-string date))
(cal-tex-hspace "3.5cm")
(cal-tex-e-makebox)
(cal-tex-hfill)
=== modified file 'lisp/calendar/calendar.el'
--- lisp/calendar/calendar.el 2013-08-07 00:06:43 +0000
+++ lisp/calendar/calendar.el 2013-08-20 21:47:27 +0000
@@ -1,4 +1,4 @@
-;;; calendar.el --- calendar functions
+;;; calendar.el --- calendar functions -*- lexical-binding:t -*-
;; Copyright (C) 1988-1995, 1997, 2000-2013 Free Software Foundation,
;; Inc.
@@ -106,15 +106,36 @@
;; Bound in diary-list-entries:
;; diary-entries-list: use in d-l, appt.el, and by diary-add-to-list
-;; diary-saved-point: only used in diary-lib.el, passed to the display func
-;; date-string: only used in diary-lib.el
-;; list-only: don't modify the diary-buffer, just return a list of entries
-;; file-glob-attrs: yuck
+;; diary--list-only: don't modify the diary-buffer, just return a list of entries
+;; diary--date-string: only used in diary-lib.el
+;; diary--saved-point: only used in diary-lib.el, passed to the display func
+;; diary--file-glob-attrs: yuck
;;; Code:
(load "cal-loaddefs" nil t)
+(defmacro calendar--eval (exp-exp env)
+ "Eval the value of EXP-EXP in the context ENV.
+ENV is a let-style list of bindings."
+ ;; While the "natural" argument ordering (to match "let") would call for
+ ;; `env' to come first, I put `env' afterwards because the implementation
+ ;; will evaluate `exp-exp' first, so I decided to preserve the usual "left to
+ ;; right" evaluation semantics.
+ (let ((env-vars (mapcar #'car env))
+ (env-exps (mapcar #'cadr env)))
+ `(funcall `(closure (t) ,',env-vars ,,exp-exp) ,@env-exps)))
+
+(defmacro calendar--evalconcat (env exp-list sep)
+ "Concatenate the result of evaluating the expressions in EXP-LIST.
+Each expression in the list returned by EXP-LIST is evaluated in the context
+ENV, while is a let-style list of bindings. SEP is the string to place between
+each result."
+ (declare (indent 1))
+ `(let ((env (list ,@(mapcar (lambda (x) `(cons ',(car x) ,(cadr x))) env))))
+ (mapconcat (lambda (e) (funcall `(closure ,env () ,e)))
+ ,exp-list ,sep)))
+
;; Avoid recursive load of calendar when loading cal-menu. Yuck.
(provide 'calendar)
(require 'cal-menu)
@@ -726,7 +747,7 @@
;; Without :initialize (require 'calendar) throws an error because
;; calendar-set-date-style is undefined at this point.
:initialize 'custom-initialize-default
- :set (lambda (symbol value)
+ :set (lambda (_symbol value)
(if value
(calendar-set-date-style 'european)
(calendar-set-date-style 'american)))
@@ -755,7 +776,7 @@
(const european :tag "Day/Month/Year")
(const iso :tag "Year/Month/Day"))
:initialize 'custom-initialize-default
- :set (lambda (symbol value)
+ :set (lambda (_symbol value)
(calendar-set-date-style value))
:group 'calendar)
@@ -1120,11 +1141,10 @@
(defconst holiday-buffer "*Holidays*"
"Name of the buffer used for the displaying the holidays.")
+(define-obsolete-variable-alias 'fancy-diary-buffer 'diary-fancy-buffer "23.1")
(defconst diary-fancy-buffer "*Fancy Diary Entries*"
"Name of the buffer used for the optional fancy display of the diary.")
-(define-obsolete-variable-alias 'fancy-diary-buffer 'diary-fancy-buffer "23.1")
-
(defconst calendar-other-calendars-buffer "*Other Calendars*"
"Name of the buffer used for the display of date on other calendars.")
@@ -1172,7 +1192,7 @@
(calendar-increment-month mon yr n)
(cons mon yr))
-(defmacro calendar-for-loop (var from init to final do &rest body)
+(defmacro calendar-for-loop (var _from init _to final _do &rest body)
"Execute a for loop.
Evaluate BODY with VAR bound to successive integers from INIT to FINAL,
inclusive. The standard macro `dotimes' is preferable in most cases."
@@ -1447,7 +1467,7 @@
(let* ((inhibit-read-only t)
(today (calendar-current-date))
(month (calendar-extract-month today))
- (day (calendar-extract-day today))
+ ;; (day (calendar-extract-day today))
(year (calendar-extract-year today))
(today-visible (or (not mon)
(<= (abs (calendar-interval mon yr month year)) 1)))
@@ -1513,7 +1533,7 @@
Inserts STRING so that it ends at INDENT. STRING is either a
literal string, or a sexp to evaluate to return such. Truncates
STRING to length TRUNCATE, and ensures a trailing space."
- (if (not (ignore-errors (stringp (setq string (eval string)))))
+ (if (not (ignore-errors (stringp string)))
(calendar-move-to-column indent)
(if (> (string-width string) truncate)
(setq string (truncate-string-to-width string truncate)))
@@ -1543,50 +1563,60 @@
(- (calendar-day-of-week (list month 1 year))
calendar-week-start-day)
7))
- (last (calendar-last-day-of-month month year))
- (trunc (min calendar-intermonth-spacing
- (1- calendar-left-margin)))
- (day 1))
- (goto-char (point-min))
- (calendar-move-to-column indent)
- (insert
- (calendar-string-spread (list calendar-month-header)
- ?\s calendar-month-digit-width))
- (calendar-ensure-newline)
- (calendar-insert-at-column indent calendar-intermonth-header trunc)
- ;; Use the first N characters of each day to head the columns.
- (dotimes (i 7)
- (insert
- (truncate-string-to-width
- (propertize (calendar-day-name (mod (+ calendar-week-start-day i) 7)
- 'header t)
- 'font-lock-face (if (memq i '(0 6))
- 'calendar-weekend-header
- 'calendar-weekday-header))
- calendar-day-header-width nil ?\s)
- (make-string (- calendar-column-width calendar-day-header-width) ?\s)))
- (calendar-ensure-newline)
- (calendar-insert-at-column indent calendar-intermonth-text trunc)
- ;; Add blank days before the first of the month.
- (insert (make-string (* blank-days calendar-column-width) ?\s))
- ;; Put in the days of the month.
- (dotimes (i last)
- (setq day (1+ i))
- ;; TODO should numbers be left-justified, centered...?
- (insert (propertize
- (format (format "%%%dd" calendar-day-digit-width) day)
- 'mouse-face 'highlight
- 'help-echo (eval calendar-date-echo-text)
- ;; 'date property prevents intermonth text confusing re-searches.
- ;; (Tried intangible, it did not really work.)
- 'date t)
- (make-string
- (- calendar-column-width calendar-day-digit-width) ?\s))
- (when (and (zerop (mod (+ day blank-days) 7))
- (/= day last))
- (calendar-ensure-newline)
- (setq day (1+ day)) ; first day of next week
- (calendar-insert-at-column indent calendar-intermonth-text trunc)))))
+ (last (calendar-last-day-of-month month year))
+ (trunc (min calendar-intermonth-spacing
+ (1- calendar-left-margin)))
+ (day 1))
+ (goto-char (point-min))
+ (calendar-move-to-column indent)
+ (insert
+ (calendar-string-spread (list (calendar--eval calendar-month-header
+ ((month month)
+ (year year))))
+ ?\s calendar-month-digit-width))
+ (calendar-ensure-newline)
+ (let ((imh (calendar--eval calendar-intermonth-header
+ ((day day) (month month) (year year)))))
+ (calendar-insert-at-column indent imh trunc))
+ ;; Use the first N characters of each day to head the columns.
+ (dotimes (i 7)
+ (insert
+ (truncate-string-to-width
+ (propertize (calendar-day-name (mod (+ calendar-week-start-day i) 7)
+ 'header t)
+ 'font-lock-face (if (memq i '(0 6))
+ 'calendar-weekend-header
+ 'calendar-weekday-header))
+ calendar-day-header-width nil ?\s)
+ (make-string (- calendar-column-width calendar-day-header-width) ?\s)))
+ (calendar-ensure-newline)
+ (let ((imt (calendar--eval calendar-intermonth-text
+ ((day day) (month month) (year year)))))
+ (calendar-insert-at-column indent imt trunc))
+ ;; Add blank days before the first of the month.
+ (insert (make-string (* blank-days calendar-column-width) ?\s))
+ ;; Put in the days of the month.
+ (dotimes (i last)
+ (setq day (1+ i))
+ ;; TODO should numbers be left-justified, centered...?
+ (insert (propertize
+ (format (format "%%%dd" calendar-day-digit-width) day)
+ 'mouse-face 'highlight
+ 'help-echo (calendar--eval
+ calendar-date-echo-text
+ ((day day) (month month) (year year)))
+ ;; 'date property prevents intermonth text confusing re-searches.
+ ;; (Tried intangible, it did not really work.)
+ 'date t)
+ (make-string
+ (- calendar-column-width calendar-day-digit-width) ?\s))
+ (when (and (zerop (mod (+ day blank-days) 7))
+ (/= day last))
+ (calendar-ensure-newline)
+ (setq day (1+ day)) ; first day of next week
+ (let ((imt (calendar--eval calendar-intermonth-text
+ ((day day) (month month) (year year)))))
+ (calendar-insert-at-column indent imt trunc))))))
(defun calendar-redraw ()
"Redraw the calendar display, if `calendar-buffer' is live."
@@ -1845,17 +1875,15 @@
(defun calendar-string-spread (strings char length)
"Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH.
-The effect is like mapconcat but the separating pieces are as balanced as
-possible. Each item of STRINGS is evaluated before concatenation so it can
-actually be an expression that evaluates to a string. If LENGTH is too short,
+The effect is like `mapconcat' but the separating pieces are as balanced as
+possible. If LENGTH is too short,
the STRINGS are just concatenated and the result truncated."
;; The algorithm is based on equation (3.25) on page 85 of Concrete
;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
;; Addison-Wesley, Reading, MA, 1989.
- (let* ((strings (mapcar 'eval
- (if (< (length strings) 2)
- (append (list "") strings (list ""))
- strings)))
+ (let* ((strings (if (< (length strings) 2)
+ `("" ,@strings "")
+ strings))
(n (- length (string-width (apply 'concat strings))))
(m (* (1- (length strings)) (char-width char)))
(s (car strings))
@@ -1881,7 +1909,9 @@
(- (car (window-inside-edges))
(car (window-edges))))) ?\s)
(calendar-string-spread
- (mapcar 'eval calendar-mode-line-format)
+ (mapcar (lambda (exp)
+ (calendar--eval exp ((date date))))
+ calendar-mode-line-format)
?\s (- calendar-right-margin (1- start))))))
(force-mode-line-update))))
@@ -2587,13 +2617,14 @@
`calendar-month-abbrev-array' and `calendar-day-abbrev-array',
respectively. An optional parameter NODAYNAME, when t, omits the
name of the day of the week."
- (let* ((dayname (unless nodayname (calendar-day-name date abbreviate)))
- (month (calendar-extract-month date))
+ (let* ((month (calendar-extract-month date)))
+ (calendar--evalconcat
+ ((dayname (unless nodayname (calendar-day-name date abbreviate)))
(monthname (calendar-month-name month abbreviate))
(day (number-to-string (calendar-extract-day date)))
(month (number-to-string month))
(year (number-to-string (calendar-extract-year date))))
- (mapconcat 'eval calendar-date-display-form "")))
+ calendar-date-display-form "")))
(defun calendar-dayname-on-or-before (dayname date)
"Return the absolute date of the DAYNAME on or before absolute DATE.
=== modified file 'lisp/calendar/diary-lib.el'
--- lisp/calendar/diary-lib.el 2013-08-05 14:26:57 +0000
+++ lisp/calendar/diary-lib.el 2013-08-20 21:52:49 +0000
@@ -1,4 +1,4 @@
-;;; diary-lib.el --- diary functions
+;;; diary-lib.el --- diary functions -*- lexical-binding:t -*-
;; Copyright (C) 1989-1990, 1992-1995, 2001-2013 Free Software
;; Foundation, Inc.
@@ -595,7 +595,7 @@
Returns a list of ENTRY followed by (ATTRIBUTE VALUE) pairs.
When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE VALUE)
pairs."
- (let (regexp regnum attrname attrname attrvalue type ret-attr)
+ (let (regexp regnum attrname attrvalue type ret-attr)
(if (null entry)
(save-excursion
(dolist (attr diary-face-attrs)
@@ -714,8 +714,8 @@
(if diary-abbreviated-year-flag
(format "\\|%02d" (% year 100))
"")))
- (case-fold-search t)
- entry-found)
+ (case-fold-search t)
+ entry-found)
(dolist (date-form diary-date-forms)
(let ((backup (when (eq (car date-form) 'backup)
(setq date-form (cdr date-form))
@@ -723,7 +723,10 @@
;; date-form uses day etc as set above.
(regexp (format "^%s?%s\\(%s\\)" (regexp-quote mark)
(if symbol (regexp-quote symbol) "")
- (mapconcat 'eval date-form "\\)\\(?:")))
+ (calendar--evalconcat
+ ((dayname dayname) (monthname monthname)
+ (month month) (day day) (year year))
+ date-form "\\)\\(?:")))
entry-start date-start temp)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -756,21 +759,22 @@
(copy-marker entry-start) (cadr temp))))))
entry-found))
-(defvar original-date) ; from diary-list-entries
-(defvar file-glob-attrs)
-(defvar list-only)
-(defvar number)
+(defvar diary--file-glob-attrs)
+(defvar diary--list-only)
(defun diary-list-entries-1 (months symbol absfunc)
"List diary entries of a certain type.
MONTHS is an array of month names. SYMBOL marks diary entries of the type
in question. ABSFUNC is a function that converts absolute dates to dates
of the appropriate type."
+ (defvar original-date)
+ (defvar number)
(let ((gdate original-date))
(dotimes (_idummy number)
(diary-list-entries-2
(funcall absfunc (calendar-absolute-from-gregorian gdate))
- diary-nonmarking-symbol file-glob-attrs list-only months symbol gdate)
+ diary-nonmarking-symbol diary--file-glob-attrs diary--list-only
+ months symbol gdate)
(setq gdate
(calendar-gregorian-from-absolute
(1+ (calendar-absolute-from-gregorian gdate))))))
@@ -780,6 +784,10 @@
"List of any diary files included in the last call to `diary-list-entries'.
Or to `diary-mark-entries'.")
+(defvar diary--saved-point) ; bound in diary-list-entries
+(defvar diary--date-string)
+(defvar diary--including)
+
(defun diary-list-entries (date number &optional list-only)
"Create and display a buffer containing the relevant lines in `diary-file'.
Selects entries for NUMBER days starting with date DATE. Hides any
@@ -819,10 +827,10 @@
`diary-hook' runs last, after the diary is displayed.
This is used e.g. by `appt-check'.
-Functions called by these hooks may use the variables ORIGINAL-DATE
-and NUMBER, which are the arguments with which this function was called.
-Note that hook functions should _not_ use DATE, but ORIGINAL-DATE.
-\(Sexp diary entries may use DATE - see `diary-list-sexp-entries'.)
+Functions called by these hooks may use the variables `original-date'
+and `number', which are the arguments with which this function was called.
+Note that hook functions should _not_ use `date', but `original-date'.
+\(Sexp diary entries may use `date' - see `diary-list-sexp-entries'.)
This function displays the list using `diary-display-function', unless
LIST-ONLY is non-nil, in which case it just returns the list."
@@ -830,13 +838,16 @@
(setq number (if (vectorp diary-number-of-entries)
(aref diary-number-of-entries (calendar-day-of-week date))
diary-number-of-entries)))
+ (defvar number) (defvar original-date)
(when (> number 0)
(let* ((original-date date) ; save for possible use in the hooks
- (date-string (calendar-date-string date))
+ (number number)
+ (diary--list-only list-only)
+ (diary--date-string (calendar-date-string date))
(diary-buffer (find-buffer-visiting diary-file))
;; Dynamically bound in diary-include-files.
- (d-incp (and (boundp 'diary-including) diary-including))
- diary-entries-list file-glob-attrs temp-buff)
+ (d-incp (and (boundp 'diary--including) diary--including))
+ diary-entries-list diary--file-glob-attrs temp-buff)
(unless d-incp
(setq diary-included-files nil)
(message "Preparing diary..."))
@@ -865,11 +876,11 @@
(setq header-line-format (and diary-header-line-flag
diary-header-line-format)))))
;; d-s-p is passed to the diary display function.
- (let ((diary-saved-point (point)))
+ (let ((diary--saved-point (point)))
(save-excursion
(save-restriction
(widen) ; bug#5093
- (setq file-glob-attrs (cadr (diary-pull-attrs nil "")))
+ (setq diary--file-glob-attrs (cadr (diary-pull-attrs nil "")))
(with-syntax-table diary-syntax-table
(goto-char (point-min))
(unless list-only
@@ -881,7 +892,7 @@
(let ((sexp-found (diary-list-sexp-entries date))
(entry-found (diary-list-entries-2
date diary-nonmarking-symbol
- file-glob-attrs list-only)))
+ diary--file-glob-attrs list-only)))
(if diary-list-include-blanks
(or sexp-found entry-found
(diary-add-to-list date "" "" "" "")))
@@ -920,8 +931,6 @@
(remove-overlays (point-min) (point-max) 'invisible 'diary))
(kill-local-variable 'mode-line-format))
-(defvar original-date) ; bound in diary-list-entries
-;(defvar number) ; already declared above
(defun diary-include-files (&optional mark)
"Process diary entries from included diary files.
@@ -931,6 +940,7 @@
Specify include files using lines matching `diary-include-string', e.g.
#include \"filename\"
This is recursive; that is, included files may include other files."
+ (defvar number) (defvar original-date)
(goto-char (point-min))
(while (re-search-forward
(format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
@@ -938,7 +948,7 @@
(let ((diary-file (match-string-no-properties 1))
(diary-mark-entries-hook 'diary-mark-included-diary-files)
(diary-list-entries-hook 'diary-include-other-diary-files)
- (diary-including t)
+ (diary--including t)
diary-hook diary-list-include-blanks efile)
(if (file-exists-p diary-file)
(if (file-readable-p diary-file)
@@ -970,40 +980,37 @@
(define-obsolete-function-alias 'include-other-diary-files
'diary-include-other-diary-files "23.1")
-(defvar date-string) ; bound in diary-list-entries
(defun diary-display-no-entries ()
"Common subroutine of `diary-simple-display' and `diary-fancy-display'.
Handles the case where there are no diary entries.
Returns a cons (NOENTRIES . HOLIDAY-STRING)."
- (let* ((holiday-list (if diary-show-holidays-flag
- (calendar-check-holidays original-date)))
- (hol-string (format "%s%s%s"
- date-string
- (if holiday-list ": " "")
- (mapconcat 'identity holiday-list "; ")))
- (msg (format "No diary entries for %s" hol-string))
- ;; Empty list, or single item with no text.
- ;; FIXME multiple items with no text?
- (noentries (or (not diary-entries-list)
- (and (not (cdr diary-entries-list))
- (string-equal "" (cadr
- (car diary-entries-list)))))))
- ;; Inconsistency: whether or not the holidays are displayed in a
- ;; separate buffer depends on if there are diary entries.
- (when noentries
- (if (or (< (length msg) (frame-width))
- (not holiday-list))
- (message "%s" msg)
- ;; holiday-list which is too wide for a message gets a buffer.
- (calendar-in-read-only-buffer holiday-buffer
- (calendar-set-mode-line (format "Holidays for %s" date-string))
- (insert (mapconcat 'identity holiday-list "\n")))
- (message "No diary entries for %s" date-string)))
- (cons noentries hol-string)))
-
-
-(defvar diary-saved-point) ; bound in diary-list-entries
+ (defvar original-date)
+ (let* ((holiday-list (if diary-show-holidays-flag
+ (calendar-check-holidays original-date)))
+ (hol-string (format "%s%s%s"
+ diary--date-string
+ (if holiday-list ": " "")
+ (mapconcat 'identity holiday-list "; ")))
+ (msg (format "No diary entries for %s" hol-string))
+ ;; Empty list, or single item with no text.
+ ;; FIXME multiple items with no text?
+ (noentries (or (not diary-entries-list)
+ (and (not (cdr diary-entries-list))
+ (string-equal "" (cadr
+ (car diary-entries-list)))))))
+ ;; Inconsistency: whether or not the holidays are displayed in a
+ ;; separate buffer depends on if there are diary entries.
+ (when noentries
+ (if (or (< (length msg) (frame-width))
+ (not holiday-list))
+ (message "%s" msg)
+ ;; holiday-list which is too wide for a message gets a buffer.
+ (calendar-in-read-only-buffer holiday-buffer
+ (calendar-set-mode-line (format "Holidays for %s" diary--date-string))
+ (insert (mapconcat 'identity holiday-list "\n")))
+ (message "No diary entries for %s" diary--date-string)))
+ (cons noentries hol-string)))
(defun diary-simple-display ()
"Display the diary buffer if there are any relevant entries or holidays.
@@ -1025,7 +1032,7 @@
(with-current-buffer dbuff
(let ((window (display-buffer (current-buffer))))
;; d-s-p is passed from diary-list-entries.
- (set-window-point window diary-saved-point)
+ (set-window-point window diary--saved-point)
(set-window-start window (point-min)))))))
(define-obsolete-function-alias 'simple-diary-display
@@ -1066,6 +1073,9 @@
(goto-char (match-beginning 1)))))
(message "Unable to locate this diary entry")))))
+(defvar displayed-year) ; bound in calendar-generate
+(defvar displayed-month)
+
(defun diary-fancy-display ()
"Prepare a diary buffer with relevant entries in a fancy, noneditable form.
Holidays are shown unless `diary-show-holidays-flag' is nil.
@@ -1155,7 +1165,7 @@
(if (eq major-mode 'diary-fancy-display-mode)
(run-hooks 'diary-fancy-display-mode-hook)
(diary-fancy-display-mode))
- (calendar-set-mode-line date-string))))
+ (calendar-set-mode-line diary--date-string))))
(define-obsolete-function-alias 'fancy-diary-display
'diary-fancy-display "23.1")
@@ -1285,7 +1295,7 @@
(defvar diary-marking-entry-flag nil
"True during the marking of diary entries, if current entry is marking.")
-;; file-glob-attrs bound in diary-mark-entries.
+;; diary--file-glob-attrs bound in diary-mark-entries.
(defun diary-mark-entries-1 (markfunc &optional months symbol absfunc)
"Mark diary entries of a certain type.
MARKFUNC is a function that marks entries of the appropriate type
@@ -1320,7 +1330,10 @@
(y-pos (if (/= l y-pos) (1+ y-pos)))
(regexp (format "^%s\\(%s\\)"
(if symbol (regexp-quote symbol) "")
- (mapconcat 'eval date-form "\\)\\("))))
+ (calendar--evalconcat
+ ((dayname dayname) (monthname monthname)
+ (month month) (day day) (year year))
+ date-form "\\)\\("))))
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(let* ((dd-name
@@ -1368,7 +1381,7 @@
(setq marks (cadr (diary-pull-attrs
(buffer-substring-no-properties
(point) (line-end-position))
- file-glob-attrs)))
+ diary--file-glob-attrs)))
;; Only mark all days of a given name if the pattern
;; contains no more specific elements.
(if (and dd-name (not (or d-pos m-pos y-pos)))
@@ -1424,8 +1437,8 @@
(let ((diary-marking-entries-flag t)
(diary-buffer (find-buffer-visiting diary-file))
;; Dynamically bound in diary-include-files.
- (d-incp (and (boundp 'diary-including) diary-including))
- file-glob-attrs temp-buff)
+ (d-incp (and (boundp 'diary--including) diary--including))
+ diary--file-glob-attrs temp-buff)
(unless d-incp
(setq diary-included-files nil)
(message "Marking diary entries..."))
@@ -1441,7 +1454,7 @@
(insert-file-contents diary-file)
(if (eq major-mode (default-value 'major-mode)) (diary-mode)))
(setq calendar-mark-diary-entries-flag t)
- (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
+ (setq diary--file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(with-syntax-table diary-syntax-table
(save-excursion
(diary-mark-entries-1 'calendar-mark-date-pattern)
@@ -1457,31 +1470,34 @@
;;;###cal-autoload
(define-obsolete-function-alias 'mark-diary-entries 'diary-mark-entries "23.1")
+(defvar diary-date) ;Previously we just used `date'.
+(defvar diary-entry) ;Previously we just used `entry'.
+
(defun diary-sexp-entry (sexp entry date)
"Process a SEXP diary ENTRY for DATE."
- (let ((result (if calendar-debug-sexp
- (let ((debug-on-error t))
- (eval (car (read-from-string sexp))))
- (let (err)
- (condition-case err
- (eval (car (read-from-string sexp)))
- (error
- (display-warning
- :error
- (format "Bad diary sexp at line %d in %s:\n%s\n\
+ (let* ((diary-date date)
+ (diary-entry entry)
+ (result (if calendar-debug-sexp
+ (let ((debug-on-error t))
+ (calendar--eval (car (read-from-string sexp))
+ ((entry entry) (date date))))
+ (condition-case err
+ (calendar--eval (car (read-from-string sexp))
+ ((entry entry) (date date)))
+ (error
+ (display-warning
+ :error
+ (format "Bad diary sexp at line %d in %s:\n%s\n\
Error: %s\n"
- (count-lines (point-min) (point))
- diary-file sexp err))
- nil))))))
+ (count-lines (point-min) (point))
+ diary-file sexp err))
+ nil)))))
(cond ((stringp result) result)
((and (consp result)
(stringp (cdr result))) result)
(result entry)
(t nil))))
-(defvar displayed-year) ; bound in calendar-generate
-(defvar displayed-month)
-
(defun diary-mark-sexp-entries ()
"Mark days in the calendar window that have sexp diary entries.
Each entry in the diary file (or included files) visible in the calendar window
@@ -1490,8 +1506,8 @@
(s-entry (format "^\\(%s(\\)\\|\\(%s%s(diary-remind\\)" sexp-mark
(regexp-quote diary-nonmarking-symbol)
sexp-mark))
- (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
- m y first-date last-date date mark file-glob-attrs
+ (diary--file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
+ m y first-date last-date date mark diary--file-glob-attrs
sexp-start sexp entry entry-start)
(with-current-buffer calendar-buffer
(setq m displayed-month
@@ -1531,7 +1547,7 @@
(calendar-gregorian-from-absolute date)))
(calendar-mark-visible-date
(calendar-gregorian-from-absolute date)
- (or (cadr (diary-pull-attrs entry file-glob-attrs))
+ (or (cadr (diary-pull-attrs entry diary--file-glob-attrs))
(if (consp mark) (car mark)))))))))
(define-obsolete-function-alias 'mark-sexp-diary-entries
@@ -1721,10 +1737,10 @@
%%(SEXP) ENTRY
-Both ENTRY and DATE are available when the SEXP is evaluated. If
-the SEXP returns nil, the diary entry does not apply. If it
-returns a non-nil value, ENTRY will be taken to apply to DATE; if
-the value is a string, that string will be the diary entry in the
+Both ENTRY and DATE are available (as `entry' resp. `date') when the SEXP
+is evaluated. If the SEXP returns nil, the diary entry does not apply.
+If it returns a non-nil value, ENTRY will be taken to apply to DATE;
+if the value is a string, that string will be the diary entry in the
fancy diary display.
For example, the following diary entry will apply to the 21st of
@@ -1826,11 +1842,11 @@
best if they are non-marking."
(let ((s-entry (format "^%s?%s(" (regexp-quote diary-nonmarking-symbol)
(regexp-quote diary-sexp-entry-symbol)))
- entry-found file-glob-attrs marks
+ entry-found diary--file-glob-attrs marks
sexp-start sexp entry specifier entry-start line-start
diary-entry temp literal)
(goto-char (point-min))
- (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
+ (setq diary--file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(while (re-search-forward s-entry nil t)
(backward-char 1)
(setq sexp-start (point))
@@ -1860,7 +1876,7 @@
(when diary-entry
(remove-overlays line-start (point) 'invisible 'diary)
(if (< 0 (length entry))
- (setq temp (diary-pull-attrs entry file-glob-attrs)
+ (setq temp (diary-pull-attrs entry diary--file-glob-attrs)
entry (nth 0 temp)
marks (nth 1 temp))))
(diary-add-to-list date entry specifier
@@ -1887,9 +1903,6 @@
;;; Sexp diary functions.
-(defvar date)
-(defvar entry)
-
;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
(defun diary-date (month day year &optional mark)
"Specific date(s) diary entry.
@@ -1904,9 +1917,9 @@
(dd (calendar-extract-day ddate))
(mm (calendar-extract-month ddate))
(yy (calendar-extract-year ddate))
- (m (calendar-extract-month date))
- (y (calendar-extract-year date))
- (d (calendar-extract-day date)))
+ (m (calendar-extract-month diary-date))
+ (y (calendar-extract-year diary-date))
+ (d (calendar-extract-day diary-date)))
(and
(or (and (listp dd) (memq d dd))
(equal d dd)
@@ -1917,7 +1930,7 @@
(or (and (listp yy) (memq y yy))
(equal y yy)
(eq yy t))
- (cons mark entry))))
+ (cons mark diary-entry))))
;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
(defun diary-block (m1 d1 y1 m2 d2 y2 &optional mark)
@@ -1932,9 +1945,9 @@
(diary-make-date m1 d1 y1)))
(date2 (calendar-absolute-from-gregorian
(diary-make-date m2 d2 y2)))
- (d (calendar-absolute-from-gregorian date)))
+ (d (calendar-absolute-from-gregorian diary-date)))
(and (<= date1 d) (<= d date2)
- (cons mark entry))))
+ (cons mark diary-entry))))
;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
(defun diary-float (month dayname n &optional day mark)
@@ -1950,10 +1963,10 @@
;; is based can be in a different month/year. For example, asking for the
;; first Monday after December 30. For large values of |n| the problem is
;; more grotesque.
- (and (= dayname (calendar-day-of-week date))
- (let* ((m (calendar-extract-month date))
- (d (calendar-extract-day date))
- (y (calendar-extract-year date))
+ (and (= dayname (calendar-day-of-week diary-date))
+ (let* ((m (calendar-extract-month diary-date))
+ (d (calendar-extract-day diary-date))
+ (y (calendar-extract-year diary-date))
;; Last (n>0) or first (n<0) possible base date for entry.
(limit
(calendar-nth-named-absday (- n) dayname m y d))
@@ -2000,7 +2013,7 @@
1
(calendar-last-day-of-month m2 y2)))
d2)))))
- (cons mark entry)))))
+ (cons mark diary-entry)))))
(defun diary-ordinal-suffix (n)
"Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)"
@@ -2028,13 +2041,13 @@
(dd (calendar-extract-day ddate))
(mm (calendar-extract-month ddate))
(yy (calendar-extract-year ddate))
- (y (calendar-extract-year date))
+ (y (calendar-extract-year diary-date))
(diff (if yy (- y yy) 100)))
(and (= mm 2) (= dd 29) (not (calendar-leap-year-p y))
(setq mm 3
dd 1))
- (and (> diff 0) (calendar-date-equal (list mm dd y) date)
- (cons mark (format entry diff (diary-ordinal-suffix diff))))))
+ (and (> diff 0) (calendar-date-equal (list mm dd y) diary-date)
+ (cons mark (format diary-entry diff (diary-ordinal-suffix diff))))))
;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
(defun diary-cyclic (n month day year &optional mark)
@@ -2050,16 +2063,16 @@
string to use when highlighting the day in the calendar."
(or (> n 0)
(error "Day count must be positive"))
- (let* ((diff (- (calendar-absolute-from-gregorian date)
+ (let* ((diff (- (calendar-absolute-from-gregorian diary-date)
(calendar-absolute-from-gregorian
(diary-make-date month day year))))
(cycle (/ diff n)))
(and (>= diff 0) (zerop (% diff n))
- (cons mark (format entry cycle (diary-ordinal-suffix cycle))))))
+ (cons mark (format diary-entry cycle (diary-ordinal-suffix cycle))))))
(defun diary-day-of-year ()
"Day of year and number of days remaining in the year of date diary entry."
- (calendar-day-of-year-string date))
+ (calendar-day-of-year-string diary-date))
(defun diary-remind (sexp days &optional marking)
"Provide a reminder of a diary entry.
@@ -2079,12 +2092,13 @@
whether the entry itself is a marking or nonmarking; if optional
parameter MARKING is non-nil then the reminders are marked on the
calendar."
- ;; `date' has a value at this point, from diary-sexp-entry.
+ ;; `diary-date' has a value at this point, from diary-sexp-entry.
;; Convert a negative number to a list of days.
(and (integerp days)
(< days 0)
(setq days (number-sequence 1 (- days))))
- (let ((diary-entry (eval sexp)))
+ (let ((diary-entry (calendar--eval sexp ((date diary-date)
+ (entry diary-entry)))))
(cond
;; Diary entry applies on date.
((and diary-entry
@@ -2096,11 +2110,14 @@
(or (not diary-marking-entries-flag) marking))
;; Adjust date, and re-evaluate.
(let ((date (calendar-gregorian-from-absolute
- (+ (calendar-absolute-from-gregorian date) days))))
- (when (setq diary-entry (eval sexp))
- ;; Discard any mark portion from diary-anniversary, etc.
- (if (consp diary-entry) (setq diary-entry (cdr diary-entry)))
- (mapconcat 'eval diary-remind-message ""))))
+ (+ (calendar-absolute-from-gregorian diary-date) days))))
+ (when (setq diary-entry (calendar--eval sexp ((date date))))
+ (calendar--evalconcat
+ ((days days) (date date)
+ ;; Discard any mark portion from diary-anniversary, etc.
+ (diary-entry (if (consp diary-entry)
+ (cdr diary-entry) diary-entry)))
+ diary-remind-message ""))))
;; Diary entry may apply to one of a list of days before date.
((and (listp days) days)
(or (diary-remind sexp (car days) marking)
@@ -2327,27 +2344,33 @@
optional ABBREV-ARRAY is present, also matches the abbreviations
from this array (with or without a final `.'), in addition to the
full month names."
- (let ((dayname (diary-name-pattern calendar-day-name-array
- calendar-day-abbrev-array t))
- (monthname (format "\\(%s\\|\\*\\)"
- (diary-name-pattern month-array abbrev-array)))
- (month "\\([0-9]+\\|\\*\\)")
- (day "\\([0-9]+\\|\\*\\)")
- (year "-?\\([0-9]+\\|\\*\\)"))
+ (let* ((dayname (diary-name-pattern calendar-day-name-array
+ calendar-day-abbrev-array t))
+ (monthname (format "\\(%s\\|\\*\\)"
+ (diary-name-pattern month-array abbrev-array)))
+ (month "\\([0-9]+\\|\\*\\)")
+ (day "\\([0-9]+\\|\\*\\)")
+ (year "-?\\([0-9]+\\|\\*\\)"))
(mapcar (lambda (x)
(cons
(concat "^" (regexp-quote diary-nonmarking-symbol) "?"
(if symbol (regexp-quote symbol) "") "\\("
- (mapconcat 'eval
- ;; If backup, omit first item (backup)
- ;; and last item (not part of date).
- (if (equal (car x) 'backup)
- (nreverse (cdr (reverse (cdr x))))
- x)
- "")
+ (calendar--evalconcat
+ ((month month) (day day) (year year)
+ (monthname monthname) (dayname dayname))
+ ;; If backup, omit first item (backup)
+ ;; and last item (not part of date).
+ (if (equal (car x) 'backup)
+ (butlast (cdr x))
+ x)
+ "")
;; With backup, last item is not part of date.
(if (equal (car x) 'backup)
- (concat "\\)" (eval (car (reverse x))))
+ (concat "\\)"
+ (calendar--eval
+ (car (last x))
+ ((month month) (day day) (year year)
+ (monthname monthname) (dayname dayname))))
"\\)"))
'(1 diary-face)))
diary-date-forms)))
@@ -2455,19 +2478,20 @@
"Return a regexp matching the first line of a fancy diary date header.
This depends on the calendar date style."
(concat
- (let ((dayname (diary-name-pattern calendar-day-name-array nil t))
- (monthname (diary-name-pattern calendar-month-name-array nil t))
- (day "1")
- (month "2")
+ ;; This is ugly. c-d-d-form expects `day' etc to be "numbers in
+ ;; string form"; eg the iso version calls string-to-number on some.
+ ;; Therefore we cannot eg just let day = "[0-9]+". (Bug#8583).
+ ;; Assumes no integers in c-day/month-name-array.
+ (replace-regexp-in-string
+ "[0-9]+" "[0-9]+"
+ (calendar--evalconcat
+ ((monthname (diary-name-pattern calendar-month-name-array nil t))
+ (dayname (diary-name-pattern calendar-day-name-array nil t))
+ (day "1") (month "2")
;; FIXME? This used to be "-?[0-9]+" - what was the "-?" for?
(year "3"))
- ;; This is ugly. c-d-d-form expects `day' etc to be "numbers in
- ;; string form"; eg the iso version calls string-to-number on some.
- ;; Therefore we cannot eg just let day = "[0-9]+". (Bug#8583).
- ;; Assumes no integers in c-day/month-name-array.
- (replace-regexp-in-string "[0-9]+" "[0-9]+"
- (mapconcat 'eval calendar-date-display-form "")
- nil t))
+ calendar-date-display-form "")
+ nil t)
;; Optional ": holiday name" after the date.
"\\(: .*\\)?"))
=== modified file 'lisp/calendar/holidays.el'
--- lisp/calendar/holidays.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/holidays.el 2013-08-20 18:33:43 +0000
@@ -1,4 +1,4 @@
-;;; holidays.el --- holiday functions for the calendar package
+;;; holidays.el --- holiday functions for the calendar package -*- lexical-binding:t -*-
;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2013 Free Software
;; Foundation, Inc.
@@ -364,7 +364,7 @@
site-init.el and `holiday-other-holidays' be set by the user.
Entries on the list are expressions that return (possibly empty) lists of
-items of the form ((month day year) string) of a holiday in the
+items of the form ((MONTH DAY YEAR) STRING) of a holiday in the
three-month period centered around `displayed-month' of `displayed-year'.
Several basic functions are provided for this purpose:
@@ -452,32 +452,31 @@
;;; End of user options.
+(defvar displayed-month) ; from calendar-generate
+(defvar displayed-year)
;; FIXME name that makes sense
;;;###diary-autoload
(defun calendar-holiday-list ()
"Form the list of holidays that occur on dates in the calendar window.
The holidays are those in the list `calendar-holidays'."
- (let (res h err)
+ (let (res)
(sort
(dolist (p calendar-holidays res)
- (if (setq h (if calendar-debug-sexp
+ (let ((h (if calendar-debug-sexp
(let ((debug-on-error t))
- (eval p))
+ (eval p)) ;; Uses displayed-year and displayed-month.
(condition-case err
- (eval p)
+ (eval p) ;; Uses displayed-year and displayed-month.
(error
(display-warning
:error
(format "Bad holiday list item: %s\nError: %s\n"
p err))
- nil))))
- (setq res (append h res))))
+ nil)))))
+ (if h (setq res (append h res)))))
'calendar-date-compare)))
-(defvar displayed-month) ; from calendar-generate
-(defvar displayed-year)
-
;; FIXME name that makes sense
;;;###cal-autoload
(defun calendar-list-holidays (&optional event)
@@ -594,7 +593,7 @@
(choice (capitalize
(completing-read "List (TAB for choices): " lists nil t)))
(which (if (string-equal choice "Ask")
- (eval (read-variable "Enter list name: "))
+ (symbol-value (read-variable "Enter list name: "))
(cdr (assoc choice lists))))
(name (if (string-equal choice "Equinoxes/Solstices")
choice
@@ -824,19 +823,14 @@
calendar window, the holiday STRING is on that date. If date is
nil, or if the date is not visible, there is no holiday."
(let ((m displayed-month)
- (y displayed-year)
- year date)
+ (y displayed-year))
(calendar-increment-month m y -1)
(holiday-filter-visible-calendar
(list
- (progn
- (setq year y
- date (eval sexp))
- (list date (if date (eval string))))
- (progn
- (setq year (1+ y)
- date (eval sexp))
- (list date (if date (eval string))))))))
+ (let ((date (calendar--eval sexp ((year y)))))
+ (list date (if date (calendar--eval string ((date date))))))
+ (let ((date (calendar--eval sexp ((year (1+ y))))))
+ (list date (if date (calendar--eval string ((date date))))))))))
(defun holiday-advent (&optional n string)
=== modified file 'lisp/calendar/lunar.el'
--- lisp/calendar/lunar.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/lunar.el 2013-08-20 19:31:41 +0000
@@ -248,21 +248,20 @@
;;;###autoload
(define-obsolete-function-alias 'phases-of-moon 'lunar-phases "23.1")
-(defvar date)
-
-;; To be called from diary-list-sexp-entries, where DATE is bound.
-
+(defvar diary-date)
+
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-lunar-phases (&optional mark)
"Moon phases diary entry.
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
- (let* ((index (lunar-index date))
+ (let* ((index (lunar-index diary-date))
(phase (lunar-phase index)))
- (while (calendar-date-compare phase (list date))
+ (while (calendar-date-compare phase (list diary-date))
(setq index (1+ index)
phase (lunar-phase index)))
- (if (calendar-date-equal (car phase) date)
+ (if (calendar-date-equal (car phase) diary-date)
(cons mark (concat (lunar-phase-name (nth 2 phase)) " "
(cadr phase))))))
=== modified file 'lisp/calendar/solar.el'
--- lisp/calendar/solar.el 2013-01-01 09:11:05 +0000
+++ lisp/calendar/solar.el 2013-08-20 21:45:18 +0000
@@ -550,12 +550,14 @@
"Printable form for decimal fraction TIME in TIME-ZONE.
Format used is given by `calendar-time-display-form'."
(let* ((time (round (* 60 time)))
- (24-hours (/ time 60))
+ (24-hours (/ time 60)))
+ (calendar--evalconcat
+ ((time-zone time-zone)
(minutes (format "%02d" (% time 60)))
(12-hours (format "%d" (1+ (% (+ 24-hours 11) 12))))
(am-pm (if (>= 24-hours 12) "pm" "am"))
(24-hours (format "%02d" 24-hours)))
- (mapconcat 'eval calendar-time-display-form "")))
+ calendar-time-display-form "")))
(defun solar-daylight (time)
"Printable form for TIME expressed in hours."
@@ -665,7 +667,7 @@
(concat "sunset " (apply 'solar-time-string (cadr l)))
"no sunset")
(if nolocation ""
- (format " at %s" (eval calendar-location-name)))
+ (format " at %s" (eval calendar-location-name))) ;No special vars!
(nth 2 l))))
(defconst solar-data-list
@@ -886,7 +888,7 @@
(last (calendar-last-day-of-month month year))
(title (format "Sunrise/sunset times for %s %d at %s"
(calendar-month-name month) year
- (eval calendar-location-name))))
+ (eval calendar-location-name)))) ;No special vars!
(calendar-in-read-only-buffer solar-sunrises-buffer
(calendar-set-mode-line title)
(insert title ":\n\n")
@@ -895,16 +897,16 @@
(insert (format "%s %2d: " (calendar-month-name month t) (1+ i))
(solar-sunrise-sunset-string date t) "\n")))))
-(defvar date)
+(defvar diary-date)
-;; To be called from diary-list-sexp-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
;;;###diary-autoload
(defun diary-sunrise-sunset ()
"Local time of sunrise and sunset as a diary entry.
Accurate to a few seconds."
(or (and calendar-latitude calendar-longitude calendar-time-zone)
(solar-setup))
- (solar-sunrise-sunset-string date))
+ (solar-sunrise-sunset-string diary-date))
;; From Meeus, 1991, page 167.
(defconst solar-seasons-data
=== modified file 'lisp/calendar/timeclock.el'
--- lisp/calendar/timeclock.el 2013-03-12 02:08:21 +0000
+++ lisp/calendar/timeclock.el 2013-08-20 18:22:47 +0000
@@ -136,7 +136,7 @@
(if value
(add-hook 'kill-emacs-query-functions 'timeclock-query-out)
(remove-hook 'kill-emacs-query-functions 'timeclock-query-out))
- (setq timeclock-ask-before-exiting value))
+ (set symbol value))
:type 'boolean
:group 'timeclock)
@@ -174,11 +174,12 @@
timeclock-update-timer)))
(setq currently-displaying nil))
(and currently-displaying
- (set-variable 'timeclock-mode-line-display nil))
- (setq timeclock-use-display-time value)
+ (setq timeclock-mode-line-display nil))
+ (set symbol value)
(and currently-displaying
- (set-variable 'timeclock-mode-line-display t))
- timeclock-use-display-time))
+ (setq timeclock-mode-line-display t))
+ ;; FIXME: The return value isn't used, AFAIK!
+ value))
:type 'boolean
:group 'timeclock
:require 'time)
@@ -269,9 +270,11 @@
(define-obsolete-function-alias 'timeclock-modeline-display
'timeclock-mode-line-display "24.3")
+(define-obsolete-variable-alias 'timeclock-modeline-display
+ 'timeclock-mode-line-display "24.3")
;;;###autoload
-(defun timeclock-mode-line-display (&optional arg)
+(define-minor-mode timeclock-mode-line-display
"Toggle display of the amount of time left today in the mode line.
If `timeclock-use-display-time' is non-nil (the default), then
the function `display-time-mode' must be active, and the mode line
@@ -280,61 +283,41 @@
updating. With prefix ARG, turn mode line display on if and only
if ARG is positive. Returns the new status of timeclock mode line
display (non-nil means on)."
- (interactive "P")
+ :global t
;; cf display-time-mode.
(setq timeclock-mode-string "")
(or global-mode-string (setq global-mode-string '("")))
- (let ((on-p (if arg
- (> (prefix-numeric-value arg) 0)
- (not timeclock-mode-line-display))))
- (if on-p
- (progn
- (or (memq 'timeclock-mode-string global-mode-string)
- (setq global-mode-string
- (append global-mode-string '(timeclock-mode-string))))
- (add-hook 'timeclock-event-hook 'timeclock-update-mode-line)
- (when timeclock-update-timer
- (cancel-timer timeclock-update-timer)
- (setq timeclock-update-timer nil))
- (if (boundp 'display-time-hook)
- (remove-hook 'display-time-hook 'timeclock-update-mode-line))
- (if timeclock-use-display-time
- (progn
- ;; Update immediately so there is a visible change
- ;; on calling this function.
- (if display-time-mode
- (timeclock-update-mode-line)
- (message "Activate `display-time-mode' or turn off \
+ (if timeclock-mode-line-display
+ (progn
+ (or (memq 'timeclock-mode-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(timeclock-mode-string))))
+ (add-hook 'timeclock-event-hook 'timeclock-update-mode-line)
+ (when timeclock-update-timer
+ (cancel-timer timeclock-update-timer)
+ (setq timeclock-update-timer nil))
+ (if (boundp 'display-time-hook)
+ (remove-hook 'display-time-hook 'timeclock-update-mode-line))
+ (if timeclock-use-display-time
+ (progn
+ ;; Update immediately so there is a visible change
+ ;; on calling this function.
+ (if display-time-mode
+ (timeclock-update-mode-line)
+ (message "Activate `display-time-mode' or turn off \
`timeclock-use-display-time' to see timeclock information"))
- (add-hook 'display-time-hook 'timeclock-update-mode-line))
- (setq timeclock-update-timer
- (run-at-time nil 60 'timeclock-update-mode-line))))
- (setq global-mode-string
- (delq 'timeclock-mode-string global-mode-string))
- (remove-hook 'timeclock-event-hook 'timeclock-update-mode-line)
- (if (boundp 'display-time-hook)
- (remove-hook 'display-time-hook
- 'timeclock-update-mode-line))
- (when timeclock-update-timer
- (cancel-timer timeclock-update-timer)
- (setq timeclock-update-timer nil)))
- (force-mode-line-update)
- (setq timeclock-mode-line-display on-p)))
-
-(define-obsolete-variable-alias 'timeclock-modeline-display
- 'timeclock-mode-line-display "24.3")
-
-;; This has to be here so that the function definition of
-;; `timeclock-mode-line-display' is known to the "set" function.
-(defcustom timeclock-mode-line-display nil
- "Toggle mode line display of time remaining.
-You must modify via \\[customize] for this variable to have an effect."
- :set (lambda (symbol value)
- (setq timeclock-mode-line-display
- (timeclock-mode-line-display (or value 0))))
- :type 'boolean
- :group 'timeclock
- :require 'timeclock)
+ (add-hook 'display-time-hook 'timeclock-update-mode-line))
+ (setq timeclock-update-timer
+ (run-at-time nil 60 'timeclock-update-mode-line))))
+ (setq global-mode-string
+ (delq 'timeclock-mode-string global-mode-string))
+ (remove-hook 'timeclock-event-hook 'timeclock-update-mode-line)
+ (if (boundp 'display-time-hook)
+ (remove-hook 'display-time-hook
+ 'timeclock-update-mode-line))
+ (when timeclock-update-timer
+ (cancel-timer timeclock-update-timer)
+ (setq timeclock-update-timer nil))))
(defsubst timeclock-time-to-date (time)
"Convert the TIME value to a textual date string."
@@ -835,25 +818,24 @@
"Return a list of all the projects in DAY."
(timeclock-entry-list-projects (cddr day)))
-(defmacro timeclock-day-list-template (func)
+(defun timeclock-day-list-template (func day-list)
"Template for summing the result of FUNC on each element of DAY-LIST."
- `(let ((length 0))
- (while day-list
- (setq length (+ length (,(eval func) (car day-list)))
- day-list (cdr day-list)))
- length))
+ (let ((length 0))
+ (dolist (day day-list)
+ (setq length (+ length (funcall func day))))
+ length))
(defun timeclock-day-list-required (day-list)
"Return total required length of DAY-LIST, in seconds."
- (timeclock-day-list-template 'timeclock-day-required))
+ (timeclock-day-list-template #'timeclock-day-required day-list))
(defun timeclock-day-list-length (day-list)
"Return actual length of DAY-LIST, in seconds."
- (timeclock-day-list-template 'timeclock-day-length))
+ (timeclock-day-list-template #'timeclock-day-length day-list))
(defun timeclock-day-list-debt (day-list)
"Return total debt (required - actual) of DAY-LIST."
- (timeclock-day-list-template 'timeclock-day-debt))
+ (timeclock-day-list-template #'timeclock-day-debt day-list))
(defsubst timeclock-day-list-begin (day-list)
"Return the start time of DAY-LIST."
@@ -865,11 +847,11 @@
(defun timeclock-day-list-span (day-list)
"Return the span of DAY-LIST."
- (timeclock-day-list-template 'timeclock-day-span))
+ (timeclock-day-list-template #'timeclock-day-span day-list))
(defun timeclock-day-list-break (day-list)
"Return the total break of DAY-LIST."
- (timeclock-day-list-template 'timeclock-day-break))
+ (timeclock-day-list-template #'timeclock-day-break day-list))
(defun timeclock-day-list-projects (day-list)
"Return a list of all the projects in DAY-LIST."
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-08-20 22:07 Trying to cope with Calendar's dynamic scoping Stefan Monnier
@ 2013-08-21 0:19 ` Edward Reingold
2013-08-21 4:30 ` Stefan Monnier
2013-08-21 1:22 ` Leo Liu
` (2 subsequent siblings)
3 siblings, 1 reply; 14+ messages in thread
From: Edward Reingold @ 2013-08-21 0:19 UTC (permalink / raw)
To: Stefan Monnier; +Cc: Edward M. Reingold, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 97054 bytes --]
My calendar code was written mostly in the early 1980s, so my memory is
unlikely to be sufficient to point out flaws in your method. But, the
diary file is permitted to have Elisp expressions for complex entries. For
example, I have
&%%(let* ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(last (calendar-last-day-of-month month year))
(dayname (calendar-day-of-week date)))
(or (and (= day last) (memq dayname '(1 2 3 4 5)))
(and (or (= day (1- last)) (= day (- last 2)))
(= dayname 5)))) 8am Print IIT pay stub
in my diary to determine the day my salary is paid. Here the variable
"date" is the relevant date, which may not be the date of the cursor in the
calendar (I may be asking for 30 days worth of calendar entries, say, or
asking from a drop-down menu). There is no way to pass this into the diary
except as a global variable. The global variables are VARIABLES OF STATE
for the whole of the calendar package.
Now I am as opposed to global variables as anybody (and I preach to my
students about the importance of avoiding them), BUT variables that
describe the global state of affairs are reasonably made global: "avoid"
does not mean "do not use". This was an engineering decision I made about
30 years ago and I still feel it is defensible. Moreover, these variables
disappear once the calendar code has done it's work.
I suspect the only reason anyone cares is that it generates warning
messages in compilation. Is there any other reason?!
Once made, my decision became interwoven in the calendar code. Messing
with it will likely break many things, but not things you will see (unless
you are the user and odd things start to happen to you). Tread very
carefully.
On Tue, Aug 20, 2013 at 5:07 PM, Stefan Monnier <monnier@iro.umontreal.ca>wrote:
> Could you look at the patch below to see if it might be workable?
> I use Calendar but only in very simple ways, so this has been tested
> only superficially.
>
> What it does is basically to wrap all calls to `eval' so as to pass the
> expected vars explicitly (so they're available in the evaluated
> expressions as locally-bound lexical vars rather than as dynamically
> scoped vars). It also moves some `eval' calls around (basically from
> generic functions to their caller) so that the precise context of those
> calls is known.
>
> It also renames `date' and `entry' to `diary-date' and `diary-entry'
> where dynamic scoping is used.
>
> While I was there I fixed some ARGNAME vs `varname' inconsistencies.
> And I turned a global boolean into a minor-mode, because it seemed to
> work better (despite the name not being "foo-mode").
>
> There are still some nasty dynamic scoping issues (most egregious is
> `number'), but we can keep them around to be sure we still have work to
> do, right?
>
>
> Stefan
>
>
> === modified file 'lisp/calendar/cal-bahai.el'
> --- lisp/calendar/cal-bahai.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-bahai.el 2013-08-20 21:44:15 +0000
> @@ -128,8 +128,10 @@
> (if (< y 1)
> "" ; pre-Bahai
> (let* ((m (calendar-extract-month bahai-date))
> - (d (calendar-extract-day bahai-date))
> - (monthname (if (and (= m 19)
> + (d (calendar-extract-day bahai-date)))
> + ;; Can't call calendar-date-string because of monthname oddity.
> + (calendar--evalconcat
> + ((monthname (if (and (= m 19)
> (<= d 0))
> "Ayyám-i-Há"
> (aref calendar-bahai-month-name-array (1- m))))
> @@ -139,9 +141,8 @@
> d)))
> (year (number-to-string y))
> (month (number-to-string m))
> - dayname)
> - ;; Can't call calendar-date-string because of monthname oddity.
> - (mapconcat 'eval calendar-date-display-form "")))))
> + (dayname nil))
> + calendar-date-display-form "")))))
>
> ;;;###cal-autoload
> (defun calendar-bahai-print-date ()
> @@ -269,7 +270,7 @@
> `diary-nongregorian-listing-hook'."
> (diary-list-entries-1 calendar-bahai-month-name-array
> diary-bahai-entry-symbol
> - 'calendar-bahai-from-absolute))
> + #'calendar-bahai-from-absolute))
> (define-obsolete-function-alias
> 'list-bahai-diary-entries 'diary-bahai-list-entries "23.1")
>
> @@ -345,13 +346,13 @@
> (define-obsolete-function-alias
> 'insert-yearly-bahai-diary-entry 'diary-bahai-insert-yearly-entry
> "23.1")
>
> -(defvar date)
> +(defvar diary-date)
>
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-bahai-date ()
> "Bahá'í calendar equivalent of date diary entry."
> - (format "Bahá'í date: %s" (calendar-bahai-date-string date)))
> + (format "Bahá'í date: %s" (calendar-bahai-date-string diary-date)))
>
>
> (provide 'cal-bahai)
>
> === modified file 'lisp/calendar/cal-china.el'
> --- lisp/calendar/cal-china.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-china.el 2013-08-20 21:44:28 +0000
> @@ -219,21 +219,22 @@
> "Absolute date of first new Zodiac sign on or after absolute date D.
> The Zodiac signs begin when the sun's longitude is a multiple of 30
> degrees."
> (let* ((year (calendar-extract-year (calendar-gregorian-from-absolute
> d)))
> - (calendar-time-zone (eval calendar-chinese-time-zone)) ; uses
> year
> - (calendar-daylight-time-offset
> - calendar-chinese-daylight-time-offset)
> - (calendar-standard-time-zone-name
> - calendar-chinese-standard-time-zone-name)
> - (calendar-daylight-time-zone-name
> - calendar-chinese-daylight-time-zone-name)
> - (calendar-daylight-savings-starts
> - calendar-chinese-daylight-saving-start)
> - (calendar-daylight-savings-ends
> - calendar-chinese-daylight-saving-end)
> - (calendar-daylight-savings-starts-time
> - calendar-chinese-daylight-saving-start-time)
> - (calendar-daylight-savings-ends-time
> - calendar-chinese-daylight-saving-end-time))
> + (calendar-time-zone (calendar--eval calendar-chinese-time-zone
> + ((year year))))
> + (calendar-daylight-time-offset
> + calendar-chinese-daylight-time-offset)
> + (calendar-standard-time-zone-name
> + calendar-chinese-standard-time-zone-name)
> + (calendar-daylight-time-zone-name
> + calendar-chinese-daylight-time-zone-name)
> + (calendar-daylight-savings-starts
> + calendar-chinese-daylight-saving-start)
> + (calendar-daylight-savings-ends
> + calendar-chinese-daylight-saving-end)
> + (calendar-daylight-savings-starts-time
> + calendar-chinese-daylight-saving-start-time)
> + (calendar-daylight-savings-ends-time
> + calendar-chinese-daylight-saving-end-time))
> (floor
> (calendar-astro-to-absolute
> (solar-date-next-longitude (calendar-astro-from-absolute d) 30)))))
> @@ -241,7 +242,8 @@
> (defun calendar-chinese-new-moon-on-or-after (d)
> "Absolute date of first new moon on or after absolute date D."
> (let* ((year (calendar-extract-year (calendar-gregorian-from-absolute
> d)))
> - (calendar-time-zone (eval calendar-chinese-time-zone))
> + (calendar-time-zone (calendar--eval calendar-chinese-time-zone
> + ((year year))))
> (calendar-daylight-time-offset
> calendar-chinese-daylight-time-offset)
> (calendar-standard-time-zone-name
> @@ -674,13 +676,13 @@
> (define-obsolete-function-alias 'calendar-goto-chinese-date
> 'calendar-chinese-goto-date "23.1")
>
> -(defvar date)
> +(defvar diary-date)
>
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-chinese-date ()
> "Chinese calendar equivalent of date diary entry."
> - (format "Chinese date: %s" (calendar-chinese-date-string date)))
> + (format "Chinese date: %s" (calendar-chinese-date-string diary-date)))
>
> (provide 'cal-china)
>
>
> === modified file 'lisp/calendar/cal-coptic.el'
> --- lisp/calendar/cal-coptic.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-coptic.el 2013-08-20 21:41:36 +0000
> @@ -119,12 +119,13 @@
> (m (calendar-extract-month coptic-date)))
> (if (< y 1)
> ""
> - (let ((monthname (aref calendar-coptic-month-name-array (1- m)))
> - (day (number-to-string (calendar-extract-day coptic-date)))
> - (dayname nil)
> - (month (number-to-string m))
> - (year (number-to-string y)))
> - (mapconcat 'eval calendar-date-display-form "")))))
> + (calendar--evalconcat
> + ((monthname (aref calendar-coptic-month-name-array (1- m)))
> + (day (number-to-string (calendar-extract-day coptic-date)))
> + (dayname nil)
> + (month (number-to-string m))
> + (year (number-to-string y)))
> + calendar-date-display-form ""))))
>
> ;;;###cal-autoload
> (defun calendar-coptic-print-date ()
> @@ -179,13 +180,13 @@
> (define-obsolete-function-alias 'calendar-goto-coptic-date
> 'calendar-coptic-goto-date "23.1")
>
> -(defvar date)
> +(defvar diary-date)
>
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-coptic-date ()
> "Coptic calendar equivalent of date diary entry."
> - (let ((f (calendar-coptic-date-string date)))
> + (let ((f (calendar-coptic-date-string diary-date)))
> (if (string-equal f "")
> (format "Date is pre-%s calendar" calendar-coptic-name)
> (format "%s date: %s" calendar-coptic-name f))))
>
> === modified file 'lisp/calendar/cal-dst.el'
> --- lisp/calendar/cal-dst.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-dst.el 2013-08-20 18:32:22 +0000
> @@ -183,6 +183,9 @@
>
> (autoload 'calendar-persian-to-absolute "cal-persia")
>
> +(defsubst calendar-dst--eval (year exp)
> + (calendar--eval exp ((year year))))
> +
> (defun calendar-time-zone-daylight-rules (abs-date utc-diff)
> "Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from
> UTC.
> ABS-DATE must specify a day that contains a daylight saving transition.
> @@ -227,10 +230,12 @@
> ;; The rule we return should give a Gregorian date, but here
> ;; we require an absolute date. The following is for efficiency.
> (setq date (cond ((eq (car rule) 'calendar-nth-named-day)
> - (eval (cons 'calendar-nth-named-absday (cdr
> rule))))
> + (calendar-dst--eval
> + year (cons 'calendar-nth-named-absday (cdr
> rule))))
> ((eq (car rule)
> 'calendar-gregorian-from-absolute)
> - (eval (cadr rule)))
> - (t (calendar-absolute-from-gregorian (eval
> rule)))))
> + (calendar-dst--eval year (cadr rule)))
> + (t (calendar-absolute-from-gregorian
> + (calendar-dst--eval year rule)))))
> (or (equal (current-time-zone
> (calendar-time-from-absolute date prevday-sec))
> (current-time-zone
> @@ -404,7 +409,7 @@
> (or (let ((expr (if calendar-dst-check-each-year-flag
> (cadr (calendar-dst-find-startend year))
> (nth 4 calendar-current-time-zone-cache))))
> - (if expr (eval expr)))
> + (if expr (calendar-dst--eval year expr)))
> ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/.
> (and (not (zerop calendar-daylight-time-offset))
> (calendar-nth-named-day 2 0 3 year))))
> @@ -415,7 +420,7 @@
> (or (let ((expr (if calendar-dst-check-each-year-flag
> (nth 2 (calendar-dst-find-startend year))
> (nth 5 calendar-current-time-zone-cache))))
> - (if expr (eval expr)))
> + (if expr (calendar-dst--eval year expr)))
> ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/.
> (and (not (zerop calendar-daylight-time-offset))
> (calendar-nth-named-day 1 0 11 year))))
> @@ -426,8 +431,10 @@
> Fractional part of DATE is local standard time of day."
> (let* ((year (calendar-extract-year
> (calendar-gregorian-from-absolute (floor date))))
> - (dst-starts-gregorian (eval calendar-daylight-savings-starts))
> - (dst-ends-gregorian (eval calendar-daylight-savings-ends))
> + (dst-starts-gregorian
> + (calendar-dst--eval year calendar-daylight-savings-starts))
> + (dst-ends-gregorian
> + (calendar-dst--eval year calendar-daylight-savings-ends))
> (dst-starts (and dst-starts-gregorian
> (+ (calendar-absolute-from-gregorian
> dst-starts-gregorian)
>
> === modified file 'lisp/calendar/cal-french.el'
> --- lisp/calendar/cal-french.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-french.el 2013-08-20 21:44:02 +0000
> @@ -252,13 +252,13 @@
> (define-obsolete-function-alias 'calendar-goto-french-date
> 'calendar-french-goto-date "23.1")
>
> -(defvar date)
> +(defvar diary-date)
>
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-french-date ()
> "French calendar equivalent of date diary entry."
> - (let ((f (calendar-french-date-string date)))
> + (let ((f (calendar-french-date-string diary-date)))
> (if (string-equal f "")
> "Date is pre-French Revolution"
> (format "French Revolutionary date: %s" f))))
>
> === modified file 'lisp/calendar/cal-hebrew.el'
> --- lisp/calendar/cal-hebrew.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-hebrew.el 2013-08-20 21:56:44 +0000
> @@ -804,15 +804,16 @@
> ;; or the corresponding day in years without that date.
> (+ (calendar-hebrew-to-absolute (list b-month 1 year)) b-day -1))))
>
> -(defvar date)
> +(defvar diary-date)
> +(defvar diary-entry)
>
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-hebrew-date ()
> "Hebrew calendar equivalent of date diary entry."
> - (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string
> date)))
> + (format "Hebrew date (until sunset): %s"
> + (calendar-hebrew-date-string diary-date)))
>
> -(defvar entry)
> (declare-function diary-ordinal-suffix "diary-lib" (n))
>
> ;;;###diary-autoload
> @@ -834,12 +835,12 @@
> (diary-make-date month day year))
> (if after-sunset 1 0))))
> (h-year (calendar-extract-year h-date)) ; birth-day
> - (d (calendar-absolute-from-gregorian date)) ; today
> + (d (calendar-absolute-from-gregorian diary-date)) ; today
> (h-yr (calendar-extract-year (calendar-hebrew-from-absolute d)))
> (age (- h-yr h-year)) ; current H year - birth H-year
> (b-date (calendar-hebrew-birthday h-date h-yr)))
> (and (> age 0) (memq b-date (list d (1+ d)))
> - (format "%s's %d%s Hebrew birthday%s" entry age
> + (format "%s's %d%s Hebrew birthday%s" diary-entry age
> (diary-ordinal-suffix age)
> (if (= b-date d) "" " (evening)")))))
>
> @@ -852,8 +853,8 @@
> use when highlighting the day in the calendar."
> (let* ((passover
> (calendar-hebrew-to-absolute
> - (list 1 15 (+ (calendar-extract-year date) 3760))))
> - (omer (- (calendar-absolute-from-gregorian date) passover))
> + (list 1 15 (+ (calendar-extract-year diary-date) 3760))))
> + (omer (- (calendar-absolute-from-gregorian diary-date) passover))
> (week (/ omer 7))
> (day (% omer 7)))
> (if (and (> omer 0) (< omer 50))
> @@ -899,14 +900,14 @@
> (diary-make-date death-month death-day death-year))
> (if after-sunset 1 0))))
> (h-year (calendar-extract-year h-date))
> - (d (calendar-absolute-from-gregorian date))
> + (d (calendar-absolute-from-gregorian diary-date))
> (yr (calendar-extract-year (calendar-hebrew-from-absolute d)))
> (diff (- yr h-year))
> (y (calendar-hebrew-yahrzeit h-date yr)))
> (if (and (> diff 0) (or (= y d) (= y (1+ d))))
> (cons mark
> (format "Yahrzeit of %s%s: %d%s anniversary"
> - entry
> + diary-entry
> (if (= y d) "" " (evening)")
> diff
> (diary-ordinal-suffix diff))))))
> @@ -921,7 +922,7 @@
>
> An optional parameter MARK specifies a face or single-character string to
> use when highlighting the day in the calendar."
> - (let* ((d (calendar-absolute-from-gregorian date))
> + (let* ((d (calendar-absolute-from-gregorian diary-date))
> (h-date (calendar-hebrew-from-absolute d))
> (h-month (calendar-extract-month h-date))
> (h-day (calendar-extract-day h-date))
> @@ -1124,7 +1125,7 @@
> "Parasha diary entry--entry applies if date is a Saturday.
> An optional parameter MARK specifies a face or single-character string to
> use when highlighting the day in the calendar."
> - (let ((d (calendar-absolute-from-gregorian date)))
> + (let ((d (calendar-absolute-from-gregorian diary-date)))
> (if (= (% d 7) 6) ; Saturday
> (let* ((h-year (calendar-extract-year
> (calendar-hebrew-from-absolute d)))
> @@ -1188,8 +1189,8 @@
> (require 'solar)
> (or (and calendar-latitude calendar-longitude calendar-time-zone)
> (solar-setup))
> - (if (= (% (calendar-absolute-from-gregorian date) 7) 5) ; Friday
> - (let ((sunset (cadr (solar-sunrise-sunset date))))
> + (if (= (% (calendar-absolute-from-gregorian diary-date) 7) 5) ; Friday
> + (let ((sunset (cadr (solar-sunrise-sunset diary-date))))
> (if sunset
> (cons mark (format
> "%s Sabbath candle lighting"
>
> === modified file 'lisp/calendar/cal-html.el'
> --- lisp/calendar/cal-html.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-html.el 2013-08-20 21:58:02 +0000
> @@ -1,4 +1,4 @@
> -;;; cal-html.el --- functions for printing HTML calendars
> +;;; cal-html.el --- functions for printing HTML calendars -*-
> lexical-binding:t -*-
>
> ;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
>
>
> === modified file 'lisp/calendar/cal-islam.el'
> --- lisp/calendar/cal-islam.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-islam.el 2013-08-20 21:43:29 +0000
> @@ -66,8 +66,8 @@
> "Absolute date of Islamic DATE.
> The absolute date is the number of days elapsed since the (imaginary)
> Gregorian date Sunday, December 31, 1 BC."
> - (let* ((month (calendar-extract-month date))
> - (day (calendar-extract-day date))
> + (let* (;; (month (calendar-extract-month date))
> + ;; (day (calendar-extract-day date))
> (year (calendar-extract-year date))
> (y (% year 30))
> (leap-years-in-cycle (cond ((< y 3) 0)
> @@ -331,13 +331,13 @@
> (define-obsolete-function-alias
> 'insert-yearly-islamic-diary-entry 'diary-islamic-insert-yearly-entry
> "23.1")
>
> -(defvar date)
> +(defvar diary-date)
>
> -;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
> +;; To be called from diary-sexp-entry, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-islamic-date ()
> "Islamic calendar equivalent of date diary entry."
> - (let ((i (calendar-islamic-date-string date)))
> + (let ((i (calendar-islamic-date-string diary-date)))
> (if (string-equal i "")
> "Date is pre-Islamic"
> (format "Islamic date (until sunset): %s" i))))
>
> === modified file 'lisp/calendar/cal-iso.el'
> --- lisp/calendar/cal-iso.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-iso.el 2013-08-20 19:26:43 +0000
> @@ -144,13 +144,13 @@
> (define-obsolete-function-alias 'calendar-goto-iso-week
> 'calendar-iso-goto-week "23.1")
>
> -(defvar date)
> +(defvar diary-date)
>
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-iso-date ()
> "ISO calendar equivalent of date diary entry."
> - (format "ISO date: %s" (calendar-iso-date-string date)))
> + (format "ISO date: %s" (calendar-iso-date-string diary-date)))
>
> (provide 'cal-iso)
>
>
> === modified file 'lisp/calendar/cal-julian.el'
> --- lisp/calendar/cal-julian.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-julian.el 2013-08-20 21:44:43 +0000
> @@ -200,20 +200,20 @@
> (define-obsolete-function-alias 'calendar-goto-astro-day-number
> 'calendar-astro-goto-day-number "23.1")
>
> -(defvar date)
> +(defvar diary-date)
>
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-julian-date ()
> "Julian calendar equivalent of date diary entry."
> - (format "Julian date: %s" (calendar-julian-date-string date)))
> + (format "Julian date: %s" (calendar-julian-date-string diary-date)))
>
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-astro-day-number ()
> "Astronomical (Julian) day number diary entry."
> (format "Astronomical (Julian) day number at noon UTC: %s.0"
> - (calendar-astro-date-string date)))
> + (calendar-astro-date-string diary-date)))
>
> (provide 'cal-julian)
>
>
> === modified file 'lisp/calendar/cal-mayan.el'
> --- lisp/calendar/cal-mayan.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-mayan.el 2013-08-20 19:27:16 +0000
> @@ -380,13 +380,13 @@
> (define-obsolete-function-alias 'calendar-goto-mayan-long-count-date
> 'calendar-mayan-goto-long-count-date "23.1")
>
> -(defvar date)
> +(defvar diary-date)
>
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-mayan-date ()
> "Show the Mayan long count, haab, and tzolkin dates as a diary entry."
> - (format "Mayan date: %s" (calendar-mayan-date-string date)))
> + (format "Mayan date: %s" (calendar-mayan-date-string diary-date)))
>
> (provide 'cal-mayan)
>
>
> === modified file 'lisp/calendar/cal-menu.el'
> --- lisp/calendar/cal-menu.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-menu.el 2013-08-20 19:23:48 +0000
> @@ -1,4 +1,4 @@
> -;;; cal-menu.el --- calendar functions for menu bar and popup menu support
> +;;; cal-menu.el --- calendar functions for menu bar and popup menu
> support -*- lexical-binding:t -*-
>
> ;; Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc.
>
> @@ -99,9 +99,9 @@
> ;; The bug has since been fixed.
> (dotimes (i 11)
> (push (vector (format "hol-year-%d" i)
> - `(lambda ()
> - (interactive)
> - (holiday-list (+ displayed-year ,(- i 5))))
> + (lambda ()
> + (interactive)
> + (holiday-list (+ displayed-year (- i 5))))
> :label `(format "For Year %d"
> (+ displayed-year ,(- i 5))))
> l))
> @@ -177,6 +177,7 @@
> (autoload 'diary-list-entries "diary-lib")
> ;; Autoloaded in diary-lib.
> (declare-function calendar-check-holidays "holidays" (date))
> +(defvar diary-list-include-blanks) ;From diary-lib.
>
> (defun calendar-mouse-view-diary-entries (&optional date diary event)
> "Pop up menu of diary entries for mouse-selected date.
>
> === modified file 'lisp/calendar/cal-persia.el'
> --- lisp/calendar/cal-persia.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-persia.el 2013-08-20 21:44:55 +0000
> @@ -148,13 +148,14 @@
> (calendar-absolute-from-gregorian
> (or date (calendar-current-date)))))
> (y (calendar-extract-year persian-date))
> - (m (calendar-extract-month persian-date))
> - (monthname (aref calendar-persian-month-name-array (1- m)))
> + (m (calendar-extract-month persian-date)))
> + (calendar--evalconcat
> + ((monthname (aref calendar-persian-month-name-array (1- m)))
> (day (number-to-string (calendar-extract-day persian-date)))
> (year (number-to-string y))
> (month (number-to-string m))
> - dayname)
> - (mapconcat 'eval calendar-date-display-form "")))
> + (dayname nil))
> + calendar-date-display-form "")))
>
> ;;;###cal-autoload
> (defun calendar-persian-print-date ()
> @@ -207,13 +208,13 @@
> (define-obsolete-function-alias 'calendar-goto-persian-date
> 'calendar-persian-goto-date "23.1")
>
> -(defvar date)
> +(defvar diary-date)
>
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-persian-date ()
> "Persian calendar equivalent of date diary entry."
> - (format "Persian date: %s" (calendar-persian-date-string date)))
> + (format "Persian date: %s" (calendar-persian-date-string diary-date)))
>
> (provide 'cal-persia)
>
>
> === modified file 'lisp/calendar/cal-tex.el'
> --- lisp/calendar/cal-tex.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/cal-tex.el 2013-08-20 19:21:33 +0000
> @@ -1,4 +1,4 @@
> -;;; cal-tex.el --- calendar functions for printing calendars with LaTeX
> +;;; cal-tex.el --- calendar functions for printing calendars with LaTeX
> -*- lexical-binding:t -*-
>
> ;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc.
>
> @@ -94,6 +94,8 @@
> :group 'calendar-tex)
>
> (defcustom cal-tex-daily-string
> + ;; FIXME: This should hold a function of one argument (the date) rather
> + ;; than an expression.
> '(let* ((year (calendar-extract-year date))
> (day (calendar-day-number date))
> (days-remaining (- (calendar-day-number (list 12 31 year))
> day)))
> @@ -115,6 +117,11 @@
> :type 'sexp
> :group 'calendar-tex)
>
> +(defsubst cal-tex-daily-string (date)
> + (if (functionp cal-tex-daily-string)
> + (funcall cal-tex-daily-string date)
> + (calendar--eval cal-tex-daily-string ((date date)))))
> +
> (defcustom cal-tex-buffer "calendar.tex"
> "The name for the output LaTeX calendar buffer."
> :type 'string
> @@ -249,6 +256,7 @@
> (define-obsolete-function-alias 'cal-tex-list-holidays 'holiday-in-range
> "24.3")
>
> (autoload 'diary-list-entries "diary-lib")
> +(defvar diary-list-include-blanks) ;From diary-lib as well.
>
> (defun cal-tex-list-diary-entries (d1 d2)
> "Generate a list of all diary-entries from absolute date D1 to D2."
> @@ -586,7 +594,7 @@
> (insert (format day-format (cal-tex-month-name month) j))
> (cal-tex-arg (cal-tex-latexify-list diary-list date))
> (cal-tex-arg (cal-tex-latexify-list holidays date))
> - (cal-tex-arg (eval cal-tex-daily-string))
> + (cal-tex-arg (cal-tex-daily-string date))
> (cal-tex-arg)
> (cal-tex-comment))
> (when (and (zerop (mod (+ j blank-days) 7))
> @@ -872,7 +880,7 @@
> (calendar-absolute-from-gregorian
> (calendar-cursor-to-date t event)))))
> (month (calendar-extract-month date))
> - (year (calendar-extract-year date))
> + ;; (year (calendar-extract-year date))
> (day (calendar-extract-day date))
> (d1 (calendar-absolute-from-gregorian date))
> (d2 (+ (* 7 n) d1))
> @@ -913,7 +921,7 @@
> (insert ": ")
> (cal-tex-large-bf s))
> (cal-tex-hfill)
> - (insert " " (eval cal-tex-daily-string))
> + (insert " " (cal-tex-daily-string date))
> (cal-tex-e-parbox)
> (cal-tex-nl)
> (cal-tex-noindent)
> @@ -932,7 +940,8 @@
> (cal-tex-e-parbox "2cm")
> (cal-tex-nl)
> (setq month (calendar-extract-month date)
> - year (calendar-extract-year date)))
> + ;; year (calendar-extract-year date)
> + ))
> (cal-tex-e-parbox)
> (unless (= i (1- n))
> (run-hooks 'cal-tex-week-hook)
> @@ -948,7 +957,7 @@
> shown are hard-coded to 8-12, 13-17."
> (let ((month (calendar-extract-month date))
> (day (calendar-extract-day date))
> - (year (calendar-extract-year date))
> + ;; (year (calendar-extract-year date))
> morning afternoon s)
> (cal-tex-comment "begin cal-tex-week-hours")
> (cal-tex-cmd "\\ \\\\[-.2cm]")
> @@ -964,7 +973,7 @@
> (insert ": ")
> (cal-tex-large-bf s))
> (cal-tex-hfill)
> - (insert " " (eval cal-tex-daily-string))
> + (insert " " (cal-tex-daily-string date))
> (cal-tex-e-parbox)
> (cal-tex-nl "-.3cm")
> (cal-tex-rule "0pt" "6.8in" ".2mm")
> @@ -1074,9 +1083,9 @@
> 1
> (calendar-absolute-from-gregorian
> (calendar-cursor-to-date t event)))))
> - (month (calendar-extract-month date))
> - (year (calendar-extract-year date))
> - (day (calendar-extract-day date))
> + ;; (month (calendar-extract-month date))
> + ;; (year (calendar-extract-year date))
> + ;; (day (calendar-extract-day date))
> (d1 (calendar-absolute-from-gregorian date))
> (d2 (+ (* 7 n) d1))
> (holidays (if cal-tex-holidays
> @@ -1142,7 +1151,7 @@
> (cal-tex-arg (number-to-string (calendar-extract-day date)))
> (cal-tex-arg (cal-tex-latexify-list diary-list date))
> (cal-tex-arg (cal-tex-latexify-list holidays date))
> - (cal-tex-arg (eval cal-tex-daily-string))
> + (cal-tex-arg (cal-tex-daily-string date))
> (insert "%\n")
> (setq date (cal-tex-incr-date date)))
> (insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
> @@ -1196,7 +1205,7 @@
> (cal-tex-arg (number-to-string (calendar-extract-day date)))
> (cal-tex-arg (cal-tex-latexify-list diary-list date))
> (cal-tex-arg (cal-tex-latexify-list holidays date))
> - (cal-tex-arg (eval cal-tex-daily-string))
> + (cal-tex-arg (cal-tex-daily-string date))
> (insert "%\n")
> (setq date (cal-tex-incr-date date)))
> (dotimes (_jdummy 2)
> @@ -1205,7 +1214,7 @@
> (cal-tex-arg (number-to-string (calendar-extract-day date)))
> (cal-tex-arg (cal-tex-latexify-list diary-list date))
> (cal-tex-arg (cal-tex-latexify-list holidays date))
> - (cal-tex-arg (eval cal-tex-daily-string))
> + (cal-tex-arg (cal-tex-daily-string date))
> (insert "%\n")
> (setq date (cal-tex-incr-date date)))
> (unless (= i (1- n))
> @@ -1244,9 +1253,9 @@
> calendar-week-start-day
> (calendar-absolute-from-gregorian
> (calendar-cursor-to-date t event)))))
> - (month (calendar-extract-month date))
> - (year (calendar-extract-year date))
> - (day (calendar-extract-day date))
> + ;; (month (calendar-extract-month date))
> + ;; (year (calendar-extract-year date))
> + ;; (day (calendar-extract-day date))
> (d1 (calendar-absolute-from-gregorian date))
> (d2 (+ (* 7 n) d1))
> (holidays (if cal-tex-holidays
> @@ -1292,7 +1301,7 @@
> (cal-tex-arg (number-to-string (calendar-extract-day date)))
> (cal-tex-arg (cal-tex-latexify-list diary-list date))
> (cal-tex-arg (cal-tex-latexify-list holidays date))
> - (cal-tex-arg (eval cal-tex-daily-string))
> + (cal-tex-arg (cal-tex-daily-string date))
> (insert "%\n")
> (setq date (cal-tex-incr-date date)))
> (unless (= i (1- n))
> @@ -1328,9 +1337,9 @@
> 1
> (calendar-absolute-from-gregorian
> (calendar-cursor-to-date t event)))))
> - (month (calendar-extract-month date))
> - (year (calendar-extract-year date))
> - (day (calendar-extract-day date))
> + ;; (month (calendar-extract-month date))
> + ;; (year (calendar-extract-year date))
> + ;; (day (calendar-extract-day date))
> (d1 (calendar-absolute-from-gregorian date))
> (d2 (+ (* 7 n) d1))
> (holidays (if cal-tex-holidays
> @@ -1364,7 +1373,7 @@
> "\\leftday")))
> (cal-tex-arg (cal-tex-latexify-list diary-list date))
> (cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
> - (cal-tex-arg (eval cal-tex-daily-string))
> + (cal-tex-arg (cal-tex-daily-string date))
> (insert "%\n")
> (if cal-tex-rules
> (insert "\\linesfill\n")
> @@ -1378,7 +1387,7 @@
> (insert "\\weekend")
> (cal-tex-arg (cal-tex-latexify-list diary-list date))
> (cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
> - (cal-tex-arg (eval cal-tex-daily-string))
> + (cal-tex-arg (cal-tex-daily-string date))
> (insert "%\n")
> (if cal-tex-rules
> (insert "\\linesfill\n")
> @@ -1440,7 +1449,7 @@
> (cal-tex-bf month-name )
> (cal-tex-e-parbox)
> (cal-tex-hspace "1cm")
> - (cal-tex-scriptsize (eval cal-tex-daily-string))
> + (cal-tex-scriptsize (cal-tex-daily-string date))
> (cal-tex-hspace "3.5cm")
> (cal-tex-e-makebox)
> (cal-tex-hfill)
>
> === modified file 'lisp/calendar/calendar.el'
> --- lisp/calendar/calendar.el 2013-08-07 00:06:43 +0000
> +++ lisp/calendar/calendar.el 2013-08-20 21:47:27 +0000
> @@ -1,4 +1,4 @@
> -;;; calendar.el --- calendar functions
> +;;; calendar.el --- calendar functions -*- lexical-binding:t -*-
>
> ;; Copyright (C) 1988-1995, 1997, 2000-2013 Free Software Foundation,
> ;; Inc.
> @@ -106,15 +106,36 @@
>
> ;; Bound in diary-list-entries:
> ;; diary-entries-list: use in d-l, appt.el, and by diary-add-to-list
> -;; diary-saved-point: only used in diary-lib.el, passed to the display
> func
> -;; date-string: only used in diary-lib.el
> -;; list-only: don't modify the diary-buffer, just return a list of entries
> -;; file-glob-attrs: yuck
> +;; diary--list-only: don't modify the diary-buffer, just return a list of
> entries
> +;; diary--date-string: only used in diary-lib.el
> +;; diary--saved-point: only used in diary-lib.el, passed to the display
> func
> +;; diary--file-glob-attrs: yuck
>
> ;;; Code:
>
> (load "cal-loaddefs" nil t)
>
> +(defmacro calendar--eval (exp-exp env)
> + "Eval the value of EXP-EXP in the context ENV.
> +ENV is a let-style list of bindings."
> + ;; While the "natural" argument ordering (to match "let") would call for
> + ;; `env' to come first, I put `env' afterwards because the
> implementation
> + ;; will evaluate `exp-exp' first, so I decided to preserve the usual
> "left to
> + ;; right" evaluation semantics.
> + (let ((env-vars (mapcar #'car env))
> + (env-exps (mapcar #'cadr env)))
> + `(funcall `(closure (t) ,',env-vars ,,exp-exp) ,@env-exps)))
> +
> +(defmacro calendar--evalconcat (env exp-list sep)
> + "Concatenate the result of evaluating the expressions in EXP-LIST.
> +Each expression in the list returned by EXP-LIST is evaluated in the
> context
> +ENV, while is a let-style list of bindings. SEP is the string to place
> between
> +each result."
> + (declare (indent 1))
> + `(let ((env (list ,@(mapcar (lambda (x) `(cons ',(car x) ,(cadr x)))
> env))))
> + (mapconcat (lambda (e) (funcall `(closure ,env () ,e)))
> + ,exp-list ,sep)))
> +
> ;; Avoid recursive load of calendar when loading cal-menu. Yuck.
> (provide 'calendar)
> (require 'cal-menu)
> @@ -726,7 +747,7 @@
> ;; Without :initialize (require 'calendar) throws an error because
> ;; calendar-set-date-style is undefined at this point.
> :initialize 'custom-initialize-default
> - :set (lambda (symbol value)
> + :set (lambda (_symbol value)
> (if value
> (calendar-set-date-style 'european)
> (calendar-set-date-style 'american)))
> @@ -755,7 +776,7 @@
> (const european :tag "Day/Month/Year")
> (const iso :tag "Year/Month/Day"))
> :initialize 'custom-initialize-default
> - :set (lambda (symbol value)
> + :set (lambda (_symbol value)
> (calendar-set-date-style value))
> :group 'calendar)
>
> @@ -1120,11 +1141,10 @@
> (defconst holiday-buffer "*Holidays*"
> "Name of the buffer used for the displaying the holidays.")
>
> +(define-obsolete-variable-alias 'fancy-diary-buffer 'diary-fancy-buffer
> "23.1")
> (defconst diary-fancy-buffer "*Fancy Diary Entries*"
> "Name of the buffer used for the optional fancy display of the diary.")
>
> -(define-obsolete-variable-alias 'fancy-diary-buffer 'diary-fancy-buffer
> "23.1")
> -
> (defconst calendar-other-calendars-buffer "*Other Calendars*"
> "Name of the buffer used for the display of date on other calendars.")
>
> @@ -1172,7 +1192,7 @@
> (calendar-increment-month mon yr n)
> (cons mon yr))
>
> -(defmacro calendar-for-loop (var from init to final do &rest body)
> +(defmacro calendar-for-loop (var _from init _to final _do &rest body)
> "Execute a for loop.
> Evaluate BODY with VAR bound to successive integers from INIT to FINAL,
> inclusive. The standard macro `dotimes' is preferable in most cases."
> @@ -1447,7 +1467,7 @@
> (let* ((inhibit-read-only t)
> (today (calendar-current-date))
> (month (calendar-extract-month today))
> - (day (calendar-extract-day today))
> + ;; (day (calendar-extract-day today))
> (year (calendar-extract-year today))
> (today-visible (or (not mon)
> (<= (abs (calendar-interval mon yr month
> year)) 1)))
> @@ -1513,7 +1533,7 @@
> Inserts STRING so that it ends at INDENT. STRING is either a
> literal string, or a sexp to evaluate to return such. Truncates
> STRING to length TRUNCATE, and ensures a trailing space."
> - (if (not (ignore-errors (stringp (setq string (eval string)))))
> + (if (not (ignore-errors (stringp string)))
> (calendar-move-to-column indent)
> (if (> (string-width string) truncate)
> (setq string (truncate-string-to-width string truncate)))
> @@ -1543,50 +1563,60 @@
> (- (calendar-day-of-week (list month 1 year))
> calendar-week-start-day)
> 7))
> - (last (calendar-last-day-of-month month year))
> - (trunc (min calendar-intermonth-spacing
> - (1- calendar-left-margin)))
> - (day 1))
> - (goto-char (point-min))
> - (calendar-move-to-column indent)
> - (insert
> - (calendar-string-spread (list calendar-month-header)
> - ?\s calendar-month-digit-width))
> - (calendar-ensure-newline)
> - (calendar-insert-at-column indent calendar-intermonth-header trunc)
> - ;; Use the first N characters of each day to head the columns.
> - (dotimes (i 7)
> - (insert
> - (truncate-string-to-width
> - (propertize (calendar-day-name (mod (+ calendar-week-start-day i)
> 7)
> - 'header t)
> - 'font-lock-face (if (memq i '(0 6))
> - 'calendar-weekend-header
> - 'calendar-weekday-header))
> - calendar-day-header-width nil ?\s)
> - (make-string (- calendar-column-width calendar-day-header-width)
> ?\s)))
> - (calendar-ensure-newline)
> - (calendar-insert-at-column indent calendar-intermonth-text trunc)
> - ;; Add blank days before the first of the month.
> - (insert (make-string (* blank-days calendar-column-width) ?\s))
> - ;; Put in the days of the month.
> - (dotimes (i last)
> - (setq day (1+ i))
> - ;; TODO should numbers be left-justified, centered...?
> - (insert (propertize
> - (format (format "%%%dd" calendar-day-digit-width) day)
> - 'mouse-face 'highlight
> - 'help-echo (eval calendar-date-echo-text)
> - ;; 'date property prevents intermonth text confusing
> re-searches.
> - ;; (Tried intangible, it did not really work.)
> - 'date t)
> - (make-string
> - (- calendar-column-width calendar-day-digit-width) ?\s))
> - (when (and (zerop (mod (+ day blank-days) 7))
> - (/= day last))
> - (calendar-ensure-newline)
> - (setq day (1+ day)) ; first day of next week
> - (calendar-insert-at-column indent calendar-intermonth-text
> trunc)))))
> + (last (calendar-last-day-of-month month year))
> + (trunc (min calendar-intermonth-spacing
> + (1- calendar-left-margin)))
> + (day 1))
> + (goto-char (point-min))
> + (calendar-move-to-column indent)
> + (insert
> + (calendar-string-spread (list (calendar--eval calendar-month-header
> + ((month month)
> + (year year))))
> + ?\s calendar-month-digit-width))
> + (calendar-ensure-newline)
> + (let ((imh (calendar--eval calendar-intermonth-header
> + ((day day) (month month) (year year)))))
> + (calendar-insert-at-column indent imh trunc))
> + ;; Use the first N characters of each day to head the columns.
> + (dotimes (i 7)
> + (insert
> + (truncate-string-to-width
> + (propertize (calendar-day-name (mod (+ calendar-week-start-day i)
> 7)
> + 'header t)
> + 'font-lock-face (if (memq i '(0 6))
> + 'calendar-weekend-header
> + 'calendar-weekday-header))
> + calendar-day-header-width nil ?\s)
> + (make-string (- calendar-column-width calendar-day-header-width)
> ?\s)))
> + (calendar-ensure-newline)
> + (let ((imt (calendar--eval calendar-intermonth-text
> + ((day day) (month month) (year year)))))
> + (calendar-insert-at-column indent imt trunc))
> + ;; Add blank days before the first of the month.
> + (insert (make-string (* blank-days calendar-column-width) ?\s))
> + ;; Put in the days of the month.
> + (dotimes (i last)
> + (setq day (1+ i))
> + ;; TODO should numbers be left-justified, centered...?
> + (insert (propertize
> + (format (format "%%%dd" calendar-day-digit-width) day)
> + 'mouse-face 'highlight
> + 'help-echo (calendar--eval
> + calendar-date-echo-text
> + ((day day) (month month) (year year)))
> + ;; 'date property prevents intermonth text confusing
> re-searches.
> + ;; (Tried intangible, it did not really work.)
> + 'date t)
> + (make-string
> + (- calendar-column-width calendar-day-digit-width) ?\s))
> + (when (and (zerop (mod (+ day blank-days) 7))
> + (/= day last))
> + (calendar-ensure-newline)
> + (setq day (1+ day)) ; first day of next week
> + (let ((imt (calendar--eval calendar-intermonth-text
> + ((day day) (month month) (year
> year)))))
> + (calendar-insert-at-column indent imt trunc))))))
>
> (defun calendar-redraw ()
> "Redraw the calendar display, if `calendar-buffer' is live."
> @@ -1845,17 +1875,15 @@
>
> (defun calendar-string-spread (strings char length)
> "Concatenate list of STRINGS separated with copies of CHAR to fill
> LENGTH.
> -The effect is like mapconcat but the separating pieces are as balanced as
> -possible. Each item of STRINGS is evaluated before concatenation so it
> can
> -actually be an expression that evaluates to a string. If LENGTH is too
> short,
> +The effect is like `mapconcat' but the separating pieces are as balanced
> as
> +possible. If LENGTH is too short,
> the STRINGS are just concatenated and the result truncated."
> ;; The algorithm is based on equation (3.25) on page 85 of Concrete
> ;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
> ;; Addison-Wesley, Reading, MA, 1989.
> - (let* ((strings (mapcar 'eval
> - (if (< (length strings) 2)
> - (append (list "") strings (list ""))
> - strings)))
> + (let* ((strings (if (< (length strings) 2)
> + `("" ,@strings "")
> + strings))
> (n (- length (string-width (apply 'concat strings))))
> (m (* (1- (length strings)) (char-width char)))
> (s (car strings))
> @@ -1881,7 +1909,9 @@
> (- (car
> (window-inside-edges))
> (car (window-edges)))))
> ?\s)
> (calendar-string-spread
> - (mapcar 'eval calendar-mode-line-format)
> + (mapcar (lambda (exp)
> + (calendar--eval exp ((date date))))
> + calendar-mode-line-format)
> ?\s (- calendar-right-margin (1- start))))))
> (force-mode-line-update))))
>
> @@ -2587,13 +2617,14 @@
> `calendar-month-abbrev-array' and `calendar-day-abbrev-array',
> respectively. An optional parameter NODAYNAME, when t, omits the
> name of the day of the week."
> - (let* ((dayname (unless nodayname (calendar-day-name date abbreviate)))
> - (month (calendar-extract-month date))
> + (let* ((month (calendar-extract-month date)))
> + (calendar--evalconcat
> + ((dayname (unless nodayname (calendar-day-name date abbreviate)))
> (monthname (calendar-month-name month abbreviate))
> (day (number-to-string (calendar-extract-day date)))
> (month (number-to-string month))
> (year (number-to-string (calendar-extract-year date))))
> - (mapconcat 'eval calendar-date-display-form "")))
> + calendar-date-display-form "")))
>
> (defun calendar-dayname-on-or-before (dayname date)
> "Return the absolute date of the DAYNAME on or before absolute DATE.
>
> === modified file 'lisp/calendar/diary-lib.el'
> --- lisp/calendar/diary-lib.el 2013-08-05 14:26:57 +0000
> +++ lisp/calendar/diary-lib.el 2013-08-20 21:52:49 +0000
> @@ -1,4 +1,4 @@
> -;;; diary-lib.el --- diary functions
> +;;; diary-lib.el --- diary functions -*- lexical-binding:t -*-
>
> ;; Copyright (C) 1989-1990, 1992-1995, 2001-2013 Free Software
> ;; Foundation, Inc.
> @@ -595,7 +595,7 @@
> Returns a list of ENTRY followed by (ATTRIBUTE VALUE) pairs.
> When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE
> VALUE)
> pairs."
> - (let (regexp regnum attrname attrname attrvalue type ret-attr)
> + (let (regexp regnum attrname attrvalue type ret-attr)
> (if (null entry)
> (save-excursion
> (dolist (attr diary-face-attrs)
> @@ -714,8 +714,8 @@
> (if diary-abbreviated-year-flag
> (format "\\|%02d" (% year 100))
> "")))
> - (case-fold-search t)
> - entry-found)
> + (case-fold-search t)
> + entry-found)
> (dolist (date-form diary-date-forms)
> (let ((backup (when (eq (car date-form) 'backup)
> (setq date-form (cdr date-form))
> @@ -723,7 +723,10 @@
> ;; date-form uses day etc as set above.
> (regexp (format "^%s?%s\\(%s\\)" (regexp-quote mark)
> (if symbol (regexp-quote symbol) "")
> - (mapconcat 'eval date-form "\\)\\(?:")))
> + (calendar--evalconcat
> + ((dayname dayname) (monthname monthname)
> + (month month) (day day) (year year))
> + date-form "\\)\\(?:")))
> entry-start date-start temp)
> (goto-char (point-min))
> (while (re-search-forward regexp nil t)
> @@ -756,21 +759,22 @@
> (copy-marker entry-start) (cadr temp))))))
> entry-found))
>
> -(defvar original-date) ; from diary-list-entries
> -(defvar file-glob-attrs)
> -(defvar list-only)
> -(defvar number)
> +(defvar diary--file-glob-attrs)
> +(defvar diary--list-only)
>
> (defun diary-list-entries-1 (months symbol absfunc)
> "List diary entries of a certain type.
> MONTHS is an array of month names. SYMBOL marks diary entries of the type
> in question. ABSFUNC is a function that converts absolute dates to dates
> of the appropriate type."
> + (defvar original-date)
> + (defvar number)
> (let ((gdate original-date))
> (dotimes (_idummy number)
> (diary-list-entries-2
> (funcall absfunc (calendar-absolute-from-gregorian gdate))
> - diary-nonmarking-symbol file-glob-attrs list-only months symbol
> gdate)
> + diary-nonmarking-symbol diary--file-glob-attrs diary--list-only
> + months symbol gdate)
> (setq gdate
> (calendar-gregorian-from-absolute
> (1+ (calendar-absolute-from-gregorian gdate))))))
> @@ -780,6 +784,10 @@
> "List of any diary files included in the last call to
> `diary-list-entries'.
> Or to `diary-mark-entries'.")
>
> +(defvar diary--saved-point) ; bound in diary-list-entries
> +(defvar diary--date-string)
> +(defvar diary--including)
> +
> (defun diary-list-entries (date number &optional list-only)
> "Create and display a buffer containing the relevant lines in
> `diary-file'.
> Selects entries for NUMBER days starting with date DATE. Hides any
> @@ -819,10 +827,10 @@
> `diary-hook' runs last, after the diary is displayed.
> This is used e.g. by `appt-check'.
>
> -Functions called by these hooks may use the variables ORIGINAL-DATE
> -and NUMBER, which are the arguments with which this function was called.
> -Note that hook functions should _not_ use DATE, but ORIGINAL-DATE.
> -\(Sexp diary entries may use DATE - see `diary-list-sexp-entries'.)
> +Functions called by these hooks may use the variables `original-date'
> +and `number', which are the arguments with which this function was called.
> +Note that hook functions should _not_ use `date', but `original-date'.
> +\(Sexp diary entries may use `date' - see `diary-list-sexp-entries'.)
>
> This function displays the list using `diary-display-function', unless
> LIST-ONLY is non-nil, in which case it just returns the list."
> @@ -830,13 +838,16 @@
> (setq number (if (vectorp diary-number-of-entries)
> (aref diary-number-of-entries (calendar-day-of-week
> date))
> diary-number-of-entries)))
> + (defvar number) (defvar original-date)
> (when (> number 0)
> (let* ((original-date date) ; save for possible use in the hooks
> - (date-string (calendar-date-string date))
> + (number number)
> + (diary--list-only list-only)
> + (diary--date-string (calendar-date-string date))
> (diary-buffer (find-buffer-visiting diary-file))
> ;; Dynamically bound in diary-include-files.
> - (d-incp (and (boundp 'diary-including) diary-including))
> - diary-entries-list file-glob-attrs temp-buff)
> + (d-incp (and (boundp 'diary--including) diary--including))
> + diary-entries-list diary--file-glob-attrs temp-buff)
> (unless d-incp
> (setq diary-included-files nil)
> (message "Preparing diary..."))
> @@ -865,11 +876,11 @@
> (setq header-line-format (and diary-header-line-flag
>
> diary-header-line-format)))))
> ;; d-s-p is passed to the diary display function.
> - (let ((diary-saved-point (point)))
> + (let ((diary--saved-point (point)))
> (save-excursion
> (save-restriction
> (widen) ; bug#5093
> - (setq file-glob-attrs (cadr (diary-pull-attrs nil "")))
> + (setq diary--file-glob-attrs (cadr (diary-pull-attrs
> nil "")))
> (with-syntax-table diary-syntax-table
> (goto-char (point-min))
> (unless list-only
> @@ -881,7 +892,7 @@
> (let ((sexp-found (diary-list-sexp-entries date))
> (entry-found (diary-list-entries-2
> date diary-nonmarking-symbol
> - file-glob-attrs list-only)))
> + diary--file-glob-attrs
> list-only)))
> (if diary-list-include-blanks
> (or sexp-found entry-found
> (diary-add-to-list date "" "" "" "")))
> @@ -920,8 +931,6 @@
> (remove-overlays (point-min) (point-max) 'invisible 'diary))
> (kill-local-variable 'mode-line-format))
>
> -(defvar original-date) ; bound in diary-list-entries
> -;(defvar number) ; already declared above
>
> (defun diary-include-files (&optional mark)
> "Process diary entries from included diary files.
> @@ -931,6 +940,7 @@
> Specify include files using lines matching `diary-include-string', e.g.
> #include \"filename\"
> This is recursive; that is, included files may include other files."
> + (defvar number) (defvar original-date)
> (goto-char (point-min))
> (while (re-search-forward
> (format "^%s \"\\([^\"]*\\)\"" (regexp-quote
> diary-include-string))
> @@ -938,7 +948,7 @@
> (let ((diary-file (match-string-no-properties 1))
> (diary-mark-entries-hook 'diary-mark-included-diary-files)
> (diary-list-entries-hook 'diary-include-other-diary-files)
> - (diary-including t)
> + (diary--including t)
> diary-hook diary-list-include-blanks efile)
> (if (file-exists-p diary-file)
> (if (file-readable-p diary-file)
> @@ -970,40 +980,37 @@
> (define-obsolete-function-alias 'include-other-diary-files
> 'diary-include-other-diary-files "23.1")
>
> -(defvar date-string) ; bound in diary-list-entries
>
> (defun diary-display-no-entries ()
> "Common subroutine of `diary-simple-display' and `diary-fancy-display'.
> Handles the case where there are no diary entries.
> Returns a cons (NOENTRIES . HOLIDAY-STRING)."
> - (let* ((holiday-list (if diary-show-holidays-flag
> - (calendar-check-holidays original-date)))
> - (hol-string (format "%s%s%s"
> - date-string
> - (if holiday-list ": " "")
> - (mapconcat 'identity holiday-list "; ")))
> - (msg (format "No diary entries for %s" hol-string))
> - ;; Empty list, or single item with no text.
> - ;; FIXME multiple items with no text?
> - (noentries (or (not diary-entries-list)
> - (and (not (cdr diary-entries-list))
> - (string-equal "" (cadr
> - (car
> diary-entries-list)))))))
> - ;; Inconsistency: whether or not the holidays are displayed in a
> - ;; separate buffer depends on if there are diary entries.
> - (when noentries
> - (if (or (< (length msg) (frame-width))
> - (not holiday-list))
> - (message "%s" msg)
> - ;; holiday-list which is too wide for a message gets a buffer.
> - (calendar-in-read-only-buffer holiday-buffer
> - (calendar-set-mode-line (format "Holidays for %s"
> date-string))
> - (insert (mapconcat 'identity holiday-list "\n")))
> - (message "No diary entries for %s" date-string)))
> - (cons noentries hol-string)))
> -
> -
> -(defvar diary-saved-point) ; bound in diary-list-entries
> + (defvar original-date)
> + (let* ((holiday-list (if diary-show-holidays-flag
> + (calendar-check-holidays original-date)))
> + (hol-string (format "%s%s%s"
> + diary--date-string
> + (if holiday-list ": " "")
> + (mapconcat 'identity holiday-list "; ")))
> + (msg (format "No diary entries for %s" hol-string))
> + ;; Empty list, or single item with no text.
> + ;; FIXME multiple items with no text?
> + (noentries (or (not diary-entries-list)
> + (and (not (cdr diary-entries-list))
> + (string-equal "" (cadr
> + (car
> diary-entries-list)))))))
> + ;; Inconsistency: whether or not the holidays are displayed in a
> + ;; separate buffer depends on if there are diary entries.
> + (when noentries
> + (if (or (< (length msg) (frame-width))
> + (not holiday-list))
> + (message "%s" msg)
> + ;; holiday-list which is too wide for a message gets a buffer.
> + (calendar-in-read-only-buffer holiday-buffer
> + (calendar-set-mode-line (format
> "Holidays for %s" diary--date-string))
> + (insert (mapconcat 'identity
> holiday-list "\n")))
> + (message "No diary entries for %s" diary--date-string)))
> + (cons noentries hol-string)))
>
> (defun diary-simple-display ()
> "Display the diary buffer if there are any relevant entries or holidays.
> @@ -1025,7 +1032,7 @@
> (with-current-buffer dbuff
> (let ((window (display-buffer (current-buffer))))
> ;; d-s-p is passed from diary-list-entries.
> - (set-window-point window diary-saved-point)
> + (set-window-point window diary--saved-point)
> (set-window-start window (point-min)))))))
>
> (define-obsolete-function-alias 'simple-diary-display
> @@ -1066,6 +1073,9 @@
> (goto-char (match-beginning 1)))))
> (message "Unable to locate this diary entry")))))
>
> +(defvar displayed-year) ; bound in calendar-generate
> +(defvar displayed-month)
> +
> (defun diary-fancy-display ()
> "Prepare a diary buffer with relevant entries in a fancy, noneditable
> form.
> Holidays are shown unless `diary-show-holidays-flag' is nil.
> @@ -1155,7 +1165,7 @@
> (if (eq major-mode 'diary-fancy-display-mode)
> (run-hooks 'diary-fancy-display-mode-hook)
> (diary-fancy-display-mode))
> - (calendar-set-mode-line date-string))))
> + (calendar-set-mode-line diary--date-string))))
>
> (define-obsolete-function-alias 'fancy-diary-display
> 'diary-fancy-display "23.1")
> @@ -1285,7 +1295,7 @@
> (defvar diary-marking-entry-flag nil
> "True during the marking of diary entries, if current entry is
> marking.")
>
> -;; file-glob-attrs bound in diary-mark-entries.
> +;; diary--file-glob-attrs bound in diary-mark-entries.
> (defun diary-mark-entries-1 (markfunc &optional months symbol absfunc)
> "Mark diary entries of a certain type.
> MARKFUNC is a function that marks entries of the appropriate type
> @@ -1320,7 +1330,10 @@
> (y-pos (if (/= l y-pos) (1+ y-pos)))
> (regexp (format "^%s\\(%s\\)"
> (if symbol (regexp-quote symbol) "")
> - (mapconcat 'eval date-form "\\)\\("))))
> + (calendar--evalconcat
> + ((dayname dayname) (monthname monthname)
> + (month month) (day day) (year year))
> + date-form "\\)\\("))))
> (goto-char (point-min))
> (while (re-search-forward regexp nil t)
> (let* ((dd-name
> @@ -1368,7 +1381,7 @@
> (setq marks (cadr (diary-pull-attrs
> (buffer-substring-no-properties
> (point) (line-end-position))
> - file-glob-attrs)))
> + diary--file-glob-attrs)))
> ;; Only mark all days of a given name if the pattern
> ;; contains no more specific elements.
> (if (and dd-name (not (or d-pos m-pos y-pos)))
> @@ -1424,8 +1437,8 @@
> (let ((diary-marking-entries-flag t)
> (diary-buffer (find-buffer-visiting diary-file))
> ;; Dynamically bound in diary-include-files.
> - (d-incp (and (boundp 'diary-including) diary-including))
> - file-glob-attrs temp-buff)
> + (d-incp (and (boundp 'diary--including) diary--including))
> + diary--file-glob-attrs temp-buff)
> (unless d-incp
> (setq diary-included-files nil)
> (message "Marking diary entries..."))
> @@ -1441,7 +1454,7 @@
> (insert-file-contents diary-file)
> (if (eq major-mode (default-value 'major-mode)) (diary-mode)))
> (setq calendar-mark-diary-entries-flag t)
> - (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
> + (setq diary--file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
> (with-syntax-table diary-syntax-table
> (save-excursion
> (diary-mark-entries-1 'calendar-mark-date-pattern)
> @@ -1457,31 +1470,34 @@
> ;;;###cal-autoload
> (define-obsolete-function-alias 'mark-diary-entries 'diary-mark-entries
> "23.1")
>
> +(defvar diary-date) ;Previously we just used `date'.
> +(defvar diary-entry) ;Previously we just used `entry'.
> +
> (defun diary-sexp-entry (sexp entry date)
> "Process a SEXP diary ENTRY for DATE."
> - (let ((result (if calendar-debug-sexp
> - (let ((debug-on-error t))
> - (eval (car (read-from-string sexp))))
> - (let (err)
> - (condition-case err
> - (eval (car (read-from-string sexp)))
> - (error
> - (display-warning
> - :error
> - (format "Bad diary sexp at line %d in %s:\n%s\n\
> + (let* ((diary-date date)
> + (diary-entry entry)
> + (result (if calendar-debug-sexp
> + (let ((debug-on-error t))
> + (calendar--eval (car (read-from-string sexp))
> + ((entry entry) (date date))))
> + (condition-case err
> + (calendar--eval (car (read-from-string sexp))
> + ((entry entry) (date date)))
> + (error
> + (display-warning
> + :error
> + (format "Bad diary sexp at line %d in %s:\n%s\n\
> Error: %s\n"
> - (count-lines (point-min) (point))
> - diary-file sexp err))
> - nil))))))
> + (count-lines (point-min) (point))
> + diary-file sexp err))
> + nil)))))
> (cond ((stringp result) result)
> ((and (consp result)
> (stringp (cdr result))) result)
> (result entry)
> (t nil))))
>
> -(defvar displayed-year) ; bound in calendar-generate
> -(defvar displayed-month)
> -
> (defun diary-mark-sexp-entries ()
> "Mark days in the calendar window that have sexp diary entries.
> Each entry in the diary file (or included files) visible in the calendar
> window
> @@ -1490,8 +1506,8 @@
> (s-entry (format "^\\(%s(\\)\\|\\(%s%s(diary-remind\\)" sexp-mark
> (regexp-quote diary-nonmarking-symbol)
> sexp-mark))
> - (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
> - m y first-date last-date date mark file-glob-attrs
> + (diary--file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
> + m y first-date last-date date mark diary--file-glob-attrs
> sexp-start sexp entry entry-start)
> (with-current-buffer calendar-buffer
> (setq m displayed-month
> @@ -1531,7 +1547,7 @@
> (calendar-gregorian-from-absolute date)))
> (calendar-mark-visible-date
> (calendar-gregorian-from-absolute date)
> - (or (cadr (diary-pull-attrs entry file-glob-attrs))
> + (or (cadr (diary-pull-attrs entry diary--file-glob-attrs))
> (if (consp mark) (car mark)))))))))
>
> (define-obsolete-function-alias 'mark-sexp-diary-entries
> @@ -1721,10 +1737,10 @@
>
> %%(SEXP) ENTRY
>
> -Both ENTRY and DATE are available when the SEXP is evaluated. If
> -the SEXP returns nil, the diary entry does not apply. If it
> -returns a non-nil value, ENTRY will be taken to apply to DATE; if
> -the value is a string, that string will be the diary entry in the
> +Both ENTRY and DATE are available (as `entry' resp. `date') when the SEXP
> +is evaluated. If the SEXP returns nil, the diary entry does not apply.
> +If it returns a non-nil value, ENTRY will be taken to apply to DATE;
> +if the value is a string, that string will be the diary entry in the
> fancy diary display.
>
> For example, the following diary entry will apply to the 21st of
> @@ -1826,11 +1842,11 @@
> best if they are non-marking."
> (let ((s-entry (format "^%s?%s(" (regexp-quote diary-nonmarking-symbol)
> (regexp-quote diary-sexp-entry-symbol)))
> - entry-found file-glob-attrs marks
> + entry-found diary--file-glob-attrs marks
> sexp-start sexp entry specifier entry-start line-start
> diary-entry temp literal)
> (goto-char (point-min))
> - (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
> + (setq diary--file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
> (while (re-search-forward s-entry nil t)
> (backward-char 1)
> (setq sexp-start (point))
> @@ -1860,7 +1876,7 @@
> (when diary-entry
> (remove-overlays line-start (point) 'invisible 'diary)
> (if (< 0 (length entry))
> - (setq temp (diary-pull-attrs entry file-glob-attrs)
> + (setq temp (diary-pull-attrs entry diary--file-glob-attrs)
> entry (nth 0 temp)
> marks (nth 1 temp))))
> (diary-add-to-list date entry specifier
> @@ -1887,9 +1903,6 @@
>
> ;;; Sexp diary functions.
>
> -(defvar date)
> -(defvar entry)
> -
> ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
> (defun diary-date (month day year &optional mark)
> "Specific date(s) diary entry.
> @@ -1904,9 +1917,9 @@
> (dd (calendar-extract-day ddate))
> (mm (calendar-extract-month ddate))
> (yy (calendar-extract-year ddate))
> - (m (calendar-extract-month date))
> - (y (calendar-extract-year date))
> - (d (calendar-extract-day date)))
> + (m (calendar-extract-month diary-date))
> + (y (calendar-extract-year diary-date))
> + (d (calendar-extract-day diary-date)))
> (and
> (or (and (listp dd) (memq d dd))
> (equal d dd)
> @@ -1917,7 +1930,7 @@
> (or (and (listp yy) (memq y yy))
> (equal y yy)
> (eq yy t))
> - (cons mark entry))))
> + (cons mark diary-entry))))
>
> ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
> (defun diary-block (m1 d1 y1 m2 d2 y2 &optional mark)
> @@ -1932,9 +1945,9 @@
> (diary-make-date m1 d1 y1)))
> (date2 (calendar-absolute-from-gregorian
> (diary-make-date m2 d2 y2)))
> - (d (calendar-absolute-from-gregorian date)))
> + (d (calendar-absolute-from-gregorian diary-date)))
> (and (<= date1 d) (<= d date2)
> - (cons mark entry))))
> + (cons mark diary-entry))))
>
> ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
> (defun diary-float (month dayname n &optional day mark)
> @@ -1950,10 +1963,10 @@
> ;; is based can be in a different month/year. For example, asking for
> the
> ;; first Monday after December 30. For large values of |n| the problem
> is
> ;; more grotesque.
> - (and (= dayname (calendar-day-of-week date))
> - (let* ((m (calendar-extract-month date))
> - (d (calendar-extract-day date))
> - (y (calendar-extract-year date))
> + (and (= dayname (calendar-day-of-week diary-date))
> + (let* ((m (calendar-extract-month diary-date))
> + (d (calendar-extract-day diary-date))
> + (y (calendar-extract-year diary-date))
> ;; Last (n>0) or first (n<0) possible base date for entry.
> (limit
> (calendar-nth-named-absday (- n) dayname m y d))
> @@ -2000,7 +2013,7 @@
> 1
> (calendar-last-day-of-month m2
> y2)))
> d2)))))
> - (cons mark entry)))))
> + (cons mark diary-entry)))))
>
> (defun diary-ordinal-suffix (n)
> "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as
> appropriate.)"
> @@ -2028,13 +2041,13 @@
> (dd (calendar-extract-day ddate))
> (mm (calendar-extract-month ddate))
> (yy (calendar-extract-year ddate))
> - (y (calendar-extract-year date))
> + (y (calendar-extract-year diary-date))
> (diff (if yy (- y yy) 100)))
> (and (= mm 2) (= dd 29) (not (calendar-leap-year-p y))
> (setq mm 3
> dd 1))
> - (and (> diff 0) (calendar-date-equal (list mm dd y) date)
> - (cons mark (format entry diff (diary-ordinal-suffix diff))))))
> + (and (> diff 0) (calendar-date-equal (list mm dd y) diary-date)
> + (cons mark (format diary-entry diff (diary-ordinal-suffix
> diff))))))
>
> ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
> (defun diary-cyclic (n month day year &optional mark)
> @@ -2050,16 +2063,16 @@
> string to use when highlighting the day in the calendar."
> (or (> n 0)
> (error "Day count must be positive"))
> - (let* ((diff (- (calendar-absolute-from-gregorian date)
> + (let* ((diff (- (calendar-absolute-from-gregorian diary-date)
> (calendar-absolute-from-gregorian
> (diary-make-date month day year))))
> (cycle (/ diff n)))
> (and (>= diff 0) (zerop (% diff n))
> - (cons mark (format entry cycle (diary-ordinal-suffix cycle))))))
> + (cons mark (format diary-entry cycle (diary-ordinal-suffix
> cycle))))))
>
> (defun diary-day-of-year ()
> "Day of year and number of days remaining in the year of date diary
> entry."
> - (calendar-day-of-year-string date))
> + (calendar-day-of-year-string diary-date))
>
> (defun diary-remind (sexp days &optional marking)
> "Provide a reminder of a diary entry.
> @@ -2079,12 +2092,13 @@
> whether the entry itself is a marking or nonmarking; if optional
> parameter MARKING is non-nil then the reminders are marked on the
> calendar."
> - ;; `date' has a value at this point, from diary-sexp-entry.
> + ;; `diary-date' has a value at this point, from diary-sexp-entry.
> ;; Convert a negative number to a list of days.
> (and (integerp days)
> (< days 0)
> (setq days (number-sequence 1 (- days))))
> - (let ((diary-entry (eval sexp)))
> + (let ((diary-entry (calendar--eval sexp ((date diary-date)
> + (entry diary-entry)))))
> (cond
> ;; Diary entry applies on date.
> ((and diary-entry
> @@ -2096,11 +2110,14 @@
> (or (not diary-marking-entries-flag) marking))
> ;; Adjust date, and re-evaluate.
> (let ((date (calendar-gregorian-from-absolute
> - (+ (calendar-absolute-from-gregorian date) days))))
> - (when (setq diary-entry (eval sexp))
> - ;; Discard any mark portion from diary-anniversary, etc.
> - (if (consp diary-entry) (setq diary-entry (cdr diary-entry)))
> - (mapconcat 'eval diary-remind-message ""))))
> + (+ (calendar-absolute-from-gregorian diary-date)
> days))))
> + (when (setq diary-entry (calendar--eval sexp ((date date))))
> + (calendar--evalconcat
> + ((days days) (date date)
> + ;; Discard any mark portion from diary-anniversary, etc.
> + (diary-entry (if (consp diary-entry)
> + (cdr diary-entry) diary-entry)))
> + diary-remind-message ""))))
> ;; Diary entry may apply to one of a list of days before date.
> ((and (listp days) days)
> (or (diary-remind sexp (car days) marking)
> @@ -2327,27 +2344,33 @@
> optional ABBREV-ARRAY is present, also matches the abbreviations
> from this array (with or without a final `.'), in addition to the
> full month names."
> - (let ((dayname (diary-name-pattern calendar-day-name-array
> - calendar-day-abbrev-array t))
> - (monthname (format "\\(%s\\|\\*\\)"
> - (diary-name-pattern month-array abbrev-array)))
> - (month "\\([0-9]+\\|\\*\\)")
> - (day "\\([0-9]+\\|\\*\\)")
> - (year "-?\\([0-9]+\\|\\*\\)"))
> + (let* ((dayname (diary-name-pattern calendar-day-name-array
> + calendar-day-abbrev-array t))
> + (monthname (format "\\(%s\\|\\*\\)"
> + (diary-name-pattern month-array
> abbrev-array)))
> + (month "\\([0-9]+\\|\\*\\)")
> + (day "\\([0-9]+\\|\\*\\)")
> + (year "-?\\([0-9]+\\|\\*\\)"))
> (mapcar (lambda (x)
> (cons
> (concat "^" (regexp-quote diary-nonmarking-symbol) "?"
> (if symbol (regexp-quote symbol) "") "\\("
> - (mapconcat 'eval
> - ;; If backup, omit first item (backup)
> - ;; and last item (not part of date).
> - (if (equal (car x) 'backup)
> - (nreverse (cdr (reverse (cdr x))))
> - x)
> - "")
> + (calendar--evalconcat
> + ((month month) (day day) (year year)
> + (monthname monthname) (dayname dayname))
> + ;; If backup, omit first item (backup)
> + ;; and last item (not part of date).
> + (if (equal (car x) 'backup)
> + (butlast (cdr x))
> + x)
> + "")
> ;; With backup, last item is not part of date.
> (if (equal (car x) 'backup)
> - (concat "\\)" (eval (car (reverse x))))
> + (concat "\\)"
> + (calendar--eval
> + (car (last x))
> + ((month month) (day day) (year year)
> + (monthname monthname) (dayname
> dayname))))
> "\\)"))
> '(1 diary-face)))
> diary-date-forms)))
> @@ -2455,19 +2478,20 @@
> "Return a regexp matching the first line of a fancy diary date header.
> This depends on the calendar date style."
> (concat
> - (let ((dayname (diary-name-pattern calendar-day-name-array nil t))
> - (monthname (diary-name-pattern calendar-month-name-array nil t))
> - (day "1")
> - (month "2")
> + ;; This is ugly. c-d-d-form expects `day' etc to be "numbers in
> + ;; string form"; eg the iso version calls string-to-number on some.
> + ;; Therefore we cannot eg just let day = "[0-9]+". (Bug#8583).
> + ;; Assumes no integers in c-day/month-name-array.
> + (replace-regexp-in-string
> + "[0-9]+" "[0-9]+"
> + (calendar--evalconcat
> + ((monthname (diary-name-pattern calendar-month-name-array nil t))
> + (dayname (diary-name-pattern calendar-day-name-array nil t))
> + (day "1") (month "2")
> ;; FIXME? This used to be "-?[0-9]+" - what was the "-?" for?
> (year "3"))
> - ;; This is ugly. c-d-d-form expects `day' etc to be "numbers in
> - ;; string form"; eg the iso version calls string-to-number on some.
> - ;; Therefore we cannot eg just let day = "[0-9]+". (Bug#8583).
> - ;; Assumes no integers in c-day/month-name-array.
> - (replace-regexp-in-string "[0-9]+" "[0-9]+"
> - (mapconcat 'eval
> calendar-date-display-form "")
> - nil t))
> + calendar-date-display-form "")
> + nil t)
> ;; Optional ": holiday name" after the date.
> "\\(: .*\\)?"))
>
>
> === modified file 'lisp/calendar/holidays.el'
> --- lisp/calendar/holidays.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/holidays.el 2013-08-20 18:33:43 +0000
> @@ -1,4 +1,4 @@
> -;;; holidays.el --- holiday functions for the calendar package
> +;;; holidays.el --- holiday functions for the calendar package -*-
> lexical-binding:t -*-
>
> ;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2013 Free Software
> ;; Foundation, Inc.
> @@ -364,7 +364,7 @@
> site-init.el and `holiday-other-holidays' be set by the user.
>
> Entries on the list are expressions that return (possibly empty) lists of
> -items of the form ((month day year) string) of a holiday in the
> +items of the form ((MONTH DAY YEAR) STRING) of a holiday in the
> three-month period centered around `displayed-month' of `displayed-year'.
> Several basic functions are provided for this purpose:
>
> @@ -452,32 +452,31 @@
>
> ;;; End of user options.
>
> +(defvar displayed-month) ; from calendar-generate
> +(defvar displayed-year)
>
> ;; FIXME name that makes sense
> ;;;###diary-autoload
> (defun calendar-holiday-list ()
> "Form the list of holidays that occur on dates in the calendar window.
> The holidays are those in the list `calendar-holidays'."
> - (let (res h err)
> + (let (res)
> (sort
> (dolist (p calendar-holidays res)
> - (if (setq h (if calendar-debug-sexp
> + (let ((h (if calendar-debug-sexp
> (let ((debug-on-error t))
> - (eval p))
> + (eval p)) ;; Uses displayed-year and
> displayed-month.
> (condition-case err
> - (eval p)
> + (eval p) ;; Uses displayed-year and
> displayed-month.
> (error
> (display-warning
> :error
> (format "Bad holiday list item: %s\nError: %s\n"
> p err))
> - nil))))
> - (setq res (append h res))))
> + nil)))))
> + (if h (setq res (append h res)))))
> 'calendar-date-compare)))
>
> -(defvar displayed-month) ; from calendar-generate
> -(defvar displayed-year)
> -
> ;; FIXME name that makes sense
> ;;;###cal-autoload
> (defun calendar-list-holidays (&optional event)
> @@ -594,7 +593,7 @@
> (choice (capitalize
> (completing-read "List (TAB for choices): " lists nil
> t)))
> (which (if (string-equal choice "Ask")
> - (eval (read-variable "Enter list name: "))
> + (symbol-value (read-variable "Enter list name: "))
> (cdr (assoc choice lists))))
> (name (if (string-equal choice "Equinoxes/Solstices")
> choice
> @@ -824,19 +823,14 @@
> calendar window, the holiday STRING is on that date. If date is
> nil, or if the date is not visible, there is no holiday."
> (let ((m displayed-month)
> - (y displayed-year)
> - year date)
> + (y displayed-year))
> (calendar-increment-month m y -1)
> (holiday-filter-visible-calendar
> (list
> - (progn
> - (setq year y
> - date (eval sexp))
> - (list date (if date (eval string))))
> - (progn
> - (setq year (1+ y)
> - date (eval sexp))
> - (list date (if date (eval string))))))))
> + (let ((date (calendar--eval sexp ((year y)))))
> + (list date (if date (calendar--eval string ((date date))))))
> + (let ((date (calendar--eval sexp ((year (1+ y))))))
> + (list date (if date (calendar--eval string ((date date))))))))))
>
>
> (defun holiday-advent (&optional n string)
>
> === modified file 'lisp/calendar/lunar.el'
> --- lisp/calendar/lunar.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/lunar.el 2013-08-20 19:31:41 +0000
> @@ -248,21 +248,20 @@
> ;;;###autoload
> (define-obsolete-function-alias 'phases-of-moon 'lunar-phases "23.1")
>
> -(defvar date)
> -
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> -
> +(defvar diary-date)
> +
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-lunar-phases (&optional mark)
> "Moon phases diary entry.
> An optional parameter MARK specifies a face or single-character string to
> use when highlighting the day in the calendar."
> - (let* ((index (lunar-index date))
> + (let* ((index (lunar-index diary-date))
> (phase (lunar-phase index)))
> - (while (calendar-date-compare phase (list date))
> + (while (calendar-date-compare phase (list diary-date))
> (setq index (1+ index)
> phase (lunar-phase index)))
> - (if (calendar-date-equal (car phase) date)
> + (if (calendar-date-equal (car phase) diary-date)
> (cons mark (concat (lunar-phase-name (nth 2 phase)) " "
> (cadr phase))))))
>
>
> === modified file 'lisp/calendar/solar.el'
> --- lisp/calendar/solar.el 2013-01-01 09:11:05 +0000
> +++ lisp/calendar/solar.el 2013-08-20 21:45:18 +0000
> @@ -550,12 +550,14 @@
> "Printable form for decimal fraction TIME in TIME-ZONE.
> Format used is given by `calendar-time-display-form'."
> (let* ((time (round (* 60 time)))
> - (24-hours (/ time 60))
> + (24-hours (/ time 60)))
> + (calendar--evalconcat
> + ((time-zone time-zone)
> (minutes (format "%02d" (% time 60)))
> (12-hours (format "%d" (1+ (% (+ 24-hours 11) 12))))
> (am-pm (if (>= 24-hours 12) "pm" "am"))
> (24-hours (format "%02d" 24-hours)))
> - (mapconcat 'eval calendar-time-display-form "")))
> + calendar-time-display-form "")))
>
> (defun solar-daylight (time)
> "Printable form for TIME expressed in hours."
> @@ -665,7 +667,7 @@
> (concat "sunset " (apply 'solar-time-string (cadr l)))
> "no sunset")
> (if nolocation ""
> - (format " at %s" (eval calendar-location-name)))
> + (format " at %s" (eval calendar-location-name))) ;No special vars!
> (nth 2 l))))
>
> (defconst solar-data-list
> @@ -886,7 +888,7 @@
> (last (calendar-last-day-of-month month year))
> (title (format "Sunrise/sunset times for %s %d at %s"
> (calendar-month-name month) year
> - (eval calendar-location-name))))
> + (eval calendar-location-name)))) ;No special vars!
> (calendar-in-read-only-buffer solar-sunrises-buffer
> (calendar-set-mode-line title)
> (insert title ":\n\n")
> @@ -895,16 +897,16 @@
> (insert (format "%s %2d: " (calendar-month-name month t) (1+ i))
> (solar-sunrise-sunset-string date t) "\n")))))
>
> -(defvar date)
> +(defvar diary-date)
>
> -;; To be called from diary-list-sexp-entries, where DATE is bound.
> +;; To be called from diary-list-sexp-entries, where `diary-date' is bound.
> ;;;###diary-autoload
> (defun diary-sunrise-sunset ()
> "Local time of sunrise and sunset as a diary entry.
> Accurate to a few seconds."
> (or (and calendar-latitude calendar-longitude calendar-time-zone)
> (solar-setup))
> - (solar-sunrise-sunset-string date))
> + (solar-sunrise-sunset-string diary-date))
>
> ;; From Meeus, 1991, page 167.
> (defconst solar-seasons-data
>
> === modified file 'lisp/calendar/timeclock.el'
> --- lisp/calendar/timeclock.el 2013-03-12 02:08:21 +0000
> +++ lisp/calendar/timeclock.el 2013-08-20 18:22:47 +0000
> @@ -136,7 +136,7 @@
> (if value
> (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
> (remove-hook 'kill-emacs-query-functions 'timeclock-query-out))
> - (setq timeclock-ask-before-exiting value))
> + (set symbol value))
> :type 'boolean
> :group 'timeclock)
>
> @@ -174,11 +174,12 @@
> timeclock-update-timer)))
> (setq currently-displaying nil))
> (and currently-displaying
> - (set-variable 'timeclock-mode-line-display nil))
> - (setq timeclock-use-display-time value)
> + (setq timeclock-mode-line-display nil))
> + (set symbol value)
> (and currently-displaying
> - (set-variable 'timeclock-mode-line-display t))
> - timeclock-use-display-time))
> + (setq timeclock-mode-line-display t))
> + ;; FIXME: The return value isn't used, AFAIK!
> + value))
> :type 'boolean
> :group 'timeclock
> :require 'time)
> @@ -269,9 +270,11 @@
>
> (define-obsolete-function-alias 'timeclock-modeline-display
> 'timeclock-mode-line-display "24.3")
> +(define-obsolete-variable-alias 'timeclock-modeline-display
> + 'timeclock-mode-line-display "24.3")
>
> ;;;###autoload
> -(defun timeclock-mode-line-display (&optional arg)
> +(define-minor-mode timeclock-mode-line-display
> "Toggle display of the amount of time left today in the mode line.
> If `timeclock-use-display-time' is non-nil (the default), then
> the function `display-time-mode' must be active, and the mode line
> @@ -280,61 +283,41 @@
> updating. With prefix ARG, turn mode line display on if and only
> if ARG is positive. Returns the new status of timeclock mode line
> display (non-nil means on)."
> - (interactive "P")
> + :global t
> ;; cf display-time-mode.
> (setq timeclock-mode-string "")
> (or global-mode-string (setq global-mode-string '("")))
> - (let ((on-p (if arg
> - (> (prefix-numeric-value arg) 0)
> - (not timeclock-mode-line-display))))
> - (if on-p
> - (progn
> - (or (memq 'timeclock-mode-string global-mode-string)
> - (setq global-mode-string
> - (append global-mode-string '(timeclock-mode-string))))
> - (add-hook 'timeclock-event-hook 'timeclock-update-mode-line)
> - (when timeclock-update-timer
> - (cancel-timer timeclock-update-timer)
> - (setq timeclock-update-timer nil))
> - (if (boundp 'display-time-hook)
> - (remove-hook 'display-time-hook 'timeclock-update-mode-line))
> - (if timeclock-use-display-time
> - (progn
> - ;; Update immediately so there is a visible change
> - ;; on calling this function.
> - (if display-time-mode
> - (timeclock-update-mode-line)
> - (message "Activate `display-time-mode' or turn off \
> + (if timeclock-mode-line-display
> + (progn
> + (or (memq 'timeclock-mode-string global-mode-string)
> + (setq global-mode-string
> + (append global-mode-string '(timeclock-mode-string))))
> + (add-hook 'timeclock-event-hook 'timeclock-update-mode-line)
> + (when timeclock-update-timer
> + (cancel-timer timeclock-update-timer)
> + (setq timeclock-update-timer nil))
> + (if (boundp 'display-time-hook)
> + (remove-hook 'display-time-hook 'timeclock-update-mode-line))
> + (if timeclock-use-display-time
> + (progn
> + ;; Update immediately so there is a visible change
> + ;; on calling this function.
> + (if display-time-mode
> + (timeclock-update-mode-line)
> + (message "Activate `display-time-mode' or turn off \
> `timeclock-use-display-time' to see timeclock information"))
> - (add-hook 'display-time-hook 'timeclock-update-mode-line))
> - (setq timeclock-update-timer
> - (run-at-time nil 60 'timeclock-update-mode-line))))
> - (setq global-mode-string
> - (delq 'timeclock-mode-string global-mode-string))
> - (remove-hook 'timeclock-event-hook 'timeclock-update-mode-line)
> - (if (boundp 'display-time-hook)
> - (remove-hook 'display-time-hook
> - 'timeclock-update-mode-line))
> - (when timeclock-update-timer
> - (cancel-timer timeclock-update-timer)
> - (setq timeclock-update-timer nil)))
> - (force-mode-line-update)
> - (setq timeclock-mode-line-display on-p)))
> -
> -(define-obsolete-variable-alias 'timeclock-modeline-display
> - 'timeclock-mode-line-display "24.3")
> -
> -;; This has to be here so that the function definition of
> -;; `timeclock-mode-line-display' is known to the "set" function.
> -(defcustom timeclock-mode-line-display nil
> - "Toggle mode line display of time remaining.
> -You must modify via \\[customize] for this variable to have an effect."
> - :set (lambda (symbol value)
> - (setq timeclock-mode-line-display
> - (timeclock-mode-line-display (or value 0))))
> - :type 'boolean
> - :group 'timeclock
> - :require 'timeclock)
> + (add-hook 'display-time-hook 'timeclock-update-mode-line))
> + (setq timeclock-update-timer
> + (run-at-time nil 60 'timeclock-update-mode-line))))
> + (setq global-mode-string
> + (delq 'timeclock-mode-string global-mode-string))
> + (remove-hook 'timeclock-event-hook 'timeclock-update-mode-line)
> + (if (boundp 'display-time-hook)
> + (remove-hook 'display-time-hook
> + 'timeclock-update-mode-line))
> + (when timeclock-update-timer
> + (cancel-timer timeclock-update-timer)
> + (setq timeclock-update-timer nil))))
>
> (defsubst timeclock-time-to-date (time)
> "Convert the TIME value to a textual date string."
> @@ -835,25 +818,24 @@
> "Return a list of all the projects in DAY."
> (timeclock-entry-list-projects (cddr day)))
>
> -(defmacro timeclock-day-list-template (func)
> +(defun timeclock-day-list-template (func day-list)
> "Template for summing the result of FUNC on each element of DAY-LIST."
> - `(let ((length 0))
> - (while day-list
> - (setq length (+ length (,(eval func) (car day-list)))
> - day-list (cdr day-list)))
> - length))
> + (let ((length 0))
> + (dolist (day day-list)
> + (setq length (+ length (funcall func day))))
> + length))
>
> (defun timeclock-day-list-required (day-list)
> "Return total required length of DAY-LIST, in seconds."
> - (timeclock-day-list-template 'timeclock-day-required))
> + (timeclock-day-list-template #'timeclock-day-required day-list))
>
> (defun timeclock-day-list-length (day-list)
> "Return actual length of DAY-LIST, in seconds."
> - (timeclock-day-list-template 'timeclock-day-length))
> + (timeclock-day-list-template #'timeclock-day-length day-list))
>
> (defun timeclock-day-list-debt (day-list)
> "Return total debt (required - actual) of DAY-LIST."
> - (timeclock-day-list-template 'timeclock-day-debt))
> + (timeclock-day-list-template #'timeclock-day-debt day-list))
>
> (defsubst timeclock-day-list-begin (day-list)
> "Return the start time of DAY-LIST."
> @@ -865,11 +847,11 @@
>
> (defun timeclock-day-list-span (day-list)
> "Return the span of DAY-LIST."
> - (timeclock-day-list-template 'timeclock-day-span))
> + (timeclock-day-list-template #'timeclock-day-span day-list))
>
> (defun timeclock-day-list-break (day-list)
> "Return the total break of DAY-LIST."
> - (timeclock-day-list-template 'timeclock-day-break))
> + (timeclock-day-list-template #'timeclock-day-break day-list))
>
> (defun timeclock-day-list-projects (day-list)
> "Return a list of all the projects in DAY-LIST."
>
>
[-- Attachment #2: Type: text/html, Size: 105966 bytes --]
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-08-20 22:07 Trying to cope with Calendar's dynamic scoping Stefan Monnier
2013-08-21 0:19 ` Edward Reingold
@ 2013-08-21 1:22 ` Leo Liu
2013-08-21 4:33 ` Stefan Monnier
2013-08-21 7:05 ` Glenn Morris
2013-09-05 4:58 ` Glenn Morris
3 siblings, 1 reply; 14+ messages in thread
From: Leo Liu @ 2013-08-21 1:22 UTC (permalink / raw)
To: Stefan Monnier; +Cc: Edward M. Reingold, emacs-devel
On 2013-08-21 06:07 +0800, Stefan Monnier wrote:
> It also renames `date' and `entry' to `diary-date' and `diary-entry'
> where dynamic scoping is used.
In diary files one can reference `date' etc. directly. This will break
those diary files.
Leo
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-08-21 0:19 ` Edward Reingold
@ 2013-08-21 4:30 ` Stefan Monnier
0 siblings, 0 replies; 14+ messages in thread
From: Stefan Monnier @ 2013-08-21 4:30 UTC (permalink / raw)
To: Edward Reingold; +Cc: Edward M. Reingold, emacs-devel
> &%%(let* ((month (extract-calendar-month date))
> (day (extract-calendar-day date))
> (year (extract-calendar-year date))
> (last (calendar-last-day-of-month month year))
> (dayname (calendar-day-of-week date)))
> (or (and (= day last) (memq dayname '(1 2 3 4 5)))
> (and (or (= day (1- last)) (= day (- last 2)))
> (= dayname 5)))) 8am Print IIT pay stub
AFAIK my patch should handle this just fine.
> I suspect the only reason anyone cares is that it generates warning
> messages in compilation. Is there any other reason?!
With the introduction of lexical scoping, using dynamic scoping on
variables that are normally only used for local vars can lead to
actual breakage (because the presence of the dynamic-scope declaration
changes the nature of the variable).
So while the problems are hypothetical so far, they're not just theoretical.
> Tread very carefully.
Indeed.
Stefan
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-08-21 1:22 ` Leo Liu
@ 2013-08-21 4:33 ` Stefan Monnier
0 siblings, 0 replies; 14+ messages in thread
From: Stefan Monnier @ 2013-08-21 4:33 UTC (permalink / raw)
To: Leo Liu; +Cc: Edward M. Reingold, emacs-devel
>> It also renames `date' and `entry' to `diary-date' and `diary-entry'
>> where dynamic scoping is used.
> In diary files one can reference `date' etc. directly. This will break
> those diary files.
In those cases, the variables are bound, just not via dynamic
scoping ;-)
It's all pretty tricky business, so please try not to assume too much
about how the code works. Instead, try it out and report
concrete problems. It may very well be that the approach won't work in
practice.
Stefan
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-08-20 22:07 Trying to cope with Calendar's dynamic scoping Stefan Monnier
2013-08-21 0:19 ` Edward Reingold
2013-08-21 1:22 ` Leo Liu
@ 2013-08-21 7:05 ` Glenn Morris
2013-09-05 4:58 ` Glenn Morris
3 siblings, 0 replies; 14+ messages in thread
From: Glenn Morris @ 2013-08-21 7:05 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
Thanks for this. I'll take a look, but not sure when at the moment.
Stefan Monnier wrote:
> And I turned a global boolean into a minor-mode, because it seemed to
> work better (despite the name not being "foo-mode").
timeclock is independent of the calendar, and I think unmaintained
(maybe it should be Maintainer: FSF):
http://lists.gnu.org/archive/html/emacs-devel/2002-07/msg00872.html
So probably you can install the timeclock changes now.
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-08-20 22:07 Trying to cope with Calendar's dynamic scoping Stefan Monnier
` (2 preceding siblings ...)
2013-08-21 7:05 ` Glenn Morris
@ 2013-09-05 4:58 ` Glenn Morris
2013-09-05 17:29 ` Stefan Monnier
3 siblings, 1 reply; 14+ messages in thread
From: Glenn Morris @ 2013-09-05 4:58 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
This looks really neat. Was there any particular aspect you thought
might not work? If not, I suggest moving to the traditional Emacs
testing phase of "install it and see what breaks".
Some minor comments follow.
> --- lisp/calendar/calendar.el 2013-08-07 00:06:43 +0000
> +++ lisp/calendar/calendar.el 2013-08-20 21:47:27 +0000
> +(defmacro calendar--eval (exp-exp env)
You've marked this as internal, but a third-party library might need to
use it. Eg if someone writes cal-foo.el for the foo calendar, it may
need to use this.
> + "Eval the value of EXP-EXP in the context ENV.
> +ENV is a let-style list of bindings."
Is there any value in making such a macro generally available?
It seems to recreate "evaluate a user-supplied expression with access to
certain dynamically bound variables" in a lexical environment.
I imagine calendar is not the only package doing that.
(Also, it seems to use the internal details of how closures are
implemented, which the lisp manual says is a no-no.)
> +(defmacro calendar--evalconcat (env exp-list sep)
> + "Concatenate the result of evaluating the expressions in EXP-LIST.
> +Each expression in the list returned by EXP-LIST is evaluated in the context
> +ENV, while is a let-style list of bindings. SEP is the string to place between
s/while/which
> Inserts STRING so that it ends at INDENT. STRING is either a
> literal string, or a sexp to evaluate to return such. Truncates
> STRING to length TRUNCATE, and ensures a trailing space."
> - (if (not (ignore-errors (stringp (setq string (eval string)))))
> + (if (not (ignore-errors (stringp string)))
It doesn't evaluate STRING any more, so the doc is wrong and the
ignore-errors is not needed.
calendar-string-spread does not evaluate its arg any more either.
You changed all the internal uses of both of these so that the eval
happens in the caller, so that's fine, but I think third-party libs
might be using these. So could they eval their arguments once more, with
day/month/year available?
> --- lisp/calendar/diary-lib.el 2013-08-05 14:26:57 +0000
> +++ lisp/calendar/diary-lib.el 2013-08-20 21:52:49 +0000
> (defun diary-list-entries-1 (months symbol absfunc)
> "List diary entries of a certain type.
> MONTHS is an array of month names. SYMBOL marks diary entries of the type
> in question. ABSFUNC is a function that converts absolute dates to dates
> of the appropriate type."
> + (defvar original-date)
> + (defvar number)
What's the significance of a defvar within a defun in this way?
> +Both ENTRY and DATE are available (as `entry' resp. `date') when the SEXP
"(as `entry' and `date', respectively)"?
otodo-mode.el still uses `date' and `entry' rather than `diary-date',
and may need updating.
Thanks again for doing this!
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-09-05 4:58 ` Glenn Morris
@ 2013-09-05 17:29 ` Stefan Monnier
2013-09-05 17:55 ` Glenn Morris
0 siblings, 1 reply; 14+ messages in thread
From: Stefan Monnier @ 2013-09-05 17:29 UTC (permalink / raw)
To: Glenn Morris; +Cc: emacs-devel
> This looks really neat. Was there any particular aspect you thought
> might not work?
Well, there's the fundamental difference between lexical and dynamic
scoping:
While you can have
&%%(blabla date blabla)
you can't have
&%%(my-cal-fun)
where my-cal-fun is defined in your .emacs as
(defun my-cal-fun () (blabla date blabla))
-- Stefan
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-09-05 17:29 ` Stefan Monnier
@ 2013-09-05 17:55 ` Glenn Morris
2013-09-05 18:59 ` Stefan Monnier
0 siblings, 1 reply; 14+ messages in thread
From: Glenn Morris @ 2013-09-05 17:55 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
Stefan Monnier wrote:
>> Was there any particular aspect you thought might not work?
>
> Well, there's the fundamental difference between lexical and dynamic
> scoping:
Oh, so nothing major then...
> While you can have
>
> &%%(blabla date blabla)
>
> you can't have
>
> &%%(my-cal-fun)
>
> where my-cal-fun is defined in your .emacs as
>
> (defun my-cal-fun () (blabla date blabla))
Or defined in any third-party library. Eg it seems this would break org,
which has "helpfully" hidden the warnings from "(defvar date)".
I don't know how common such usage is.
If you think we need to move to lexical scoping for everything, then the
incompatible change has to be made at some point, it seems.
Maybe Emacs 25.1 is more appropriate for something like that?
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-09-05 17:55 ` Glenn Morris
@ 2013-09-05 18:59 ` Stefan Monnier
2013-09-06 1:20 ` Glenn Morris
0 siblings, 1 reply; 14+ messages in thread
From: Stefan Monnier @ 2013-09-05 18:59 UTC (permalink / raw)
To: Glenn Morris; +Cc: emacs-devel
> Or defined in any third-party library. Eg it seems this would break org,
> which has "helpfully" hidden the warnings from "(defvar date)".
Aha! So indeed it breaks `org-diary'. And of course
org-diary-sexp-entry (which reproduces Calendar's behavior).
> I don't know how common such usage is.
Don't know either. But it means we have to keep using dynamic scoping
for `date' and `entry', for now.
Stefan
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-09-05 18:59 ` Stefan Monnier
@ 2013-09-06 1:20 ` Glenn Morris
2013-09-06 14:58 ` Stefan Monnier
0 siblings, 1 reply; 14+ messages in thread
From: Glenn Morris @ 2013-09-06 1:20 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
Stefan Monnier wrote:
> But it means we have to keep using dynamic scoping for `date' and
> `entry', for now.
Well, it has to be done at some point, doesn't it?
And can't you have code which works in either version just by using
(if (boundp 'diary-date) diary-date date)
?
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-09-06 1:20 ` Glenn Morris
@ 2013-09-06 14:58 ` Stefan Monnier
2013-09-06 16:02 ` Glenn Morris
0 siblings, 1 reply; 14+ messages in thread
From: Stefan Monnier @ 2013-09-06 14:58 UTC (permalink / raw)
To: Glenn Morris; +Cc: emacs-devel
>> But it means we have to keep using dynamic scoping for `date' and
>> `entry', for now.
> Well, it has to be done at some point, doesn't it?
> And can't you have code which works in either version just by using
> (if (boundp 'diary-date) diary-date date)
> ?
Right. My patch does provide diary-date and diary-entry, so code
can/should start doing the above, but we should keep the old code
working a bit longer by also providing the old names via dynamic scoping
(since lexical scoping is not quite sufficient for that).
Stefan
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-09-06 14:58 ` Stefan Monnier
@ 2013-09-06 16:02 ` Glenn Morris
2013-09-06 17:16 ` Stefan Monnier
0 siblings, 1 reply; 14+ messages in thread
From: Glenn Morris @ 2013-09-06 16:02 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
Stefan Monnier wrote:
> My patch does provide diary-date and diary-entry, so code can/should
> start doing the above, but we should keep the old code working a bit
> longer by also providing the old names via dynamic scoping (since
> lexical scoping is not quite sufficient for that).
Sounds good. Could you install the bit that adds diary-date, -entry, and
we can start advertising those for use in future?
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: Trying to cope with Calendar's dynamic scoping
2013-09-06 16:02 ` Glenn Morris
@ 2013-09-06 17:16 ` Stefan Monnier
0 siblings, 0 replies; 14+ messages in thread
From: Stefan Monnier @ 2013-09-06 17:16 UTC (permalink / raw)
To: Glenn Morris; +Cc: emacs-devel
>> My patch does provide diary-date and diary-entry, so code can/should
>> start doing the above, but we should keep the old code working a bit
>> longer by also providing the old names via dynamic scoping (since
>> lexical scoping is not quite sufficient for that).
> Sounds good. Could you install the bit that adds diary-date, -entry, and
> we can start advertising those for use in future?
I will, yes.
Stefan
^ permalink raw reply [flat|nested] 14+ messages in thread
end of thread, other threads:[~2013-09-06 17:16 UTC | newest]
Thread overview: 14+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-08-20 22:07 Trying to cope with Calendar's dynamic scoping Stefan Monnier
2013-08-21 0:19 ` Edward Reingold
2013-08-21 4:30 ` Stefan Monnier
2013-08-21 1:22 ` Leo Liu
2013-08-21 4:33 ` Stefan Monnier
2013-08-21 7:05 ` Glenn Morris
2013-09-05 4:58 ` Glenn Morris
2013-09-05 17:29 ` Stefan Monnier
2013-09-05 17:55 ` Glenn Morris
2013-09-05 18:59 ` Stefan Monnier
2013-09-06 1:20 ` Glenn Morris
2013-09-06 14:58 ` Stefan Monnier
2013-09-06 16:02 ` Glenn Morris
2013-09-06 17:16 ` Stefan Monnier
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).