[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Trying to cope with Calendar's dynamic scoping
|
From: |
Stefan Monnier |
|
Subject: |
Trying to cope with Calendar's dynamic scoping |
|
Date: |
Tue, 20 Aug 2013 18:07:45 -0400 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.3.50 (gnu/linux) |
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."
- Trying to cope with Calendar's dynamic scoping,
Stefan Monnier <=