From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: Trying to cope with Calendar's dynamic scoping Date: Tue, 20 Aug 2013 18:07:45 -0400 Message-ID: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: quoted-printable X-Trace: ger.gmane.org 1377036499 25654 80.91.229.3 (20 Aug 2013 22:08:19 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 20 Aug 2013 22:08:19 +0000 (UTC) Cc: "Edward M. Reingold" , emacs-devel@gnu.org To: Glenn Morris Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Aug 21 00:08:22 2013 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VBu68-0005ky-TW for ged-emacs-devel@m.gmane.org; Wed, 21 Aug 2013 00:08:21 +0200 Original-Received: from localhost ([::1]:50293 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VBu68-0006U5-Dg for ged-emacs-devel@m.gmane.org; Tue, 20 Aug 2013 18:08:20 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:41801) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VBu5y-0006SC-P6 for emacs-devel@gnu.org; Tue, 20 Aug 2013 18:08:17 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VBu5r-0003pZ-N2 for emacs-devel@gnu.org; Tue, 20 Aug 2013 18:08:10 -0400 Original-Received: from pruche.dit.umontreal.ca ([132.204.246.22]:45883) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VBu5j-0003nD-AG; Tue, 20 Aug 2013 18:07:55 -0400 Original-Received: from fmsmemgm.homelinux.net (lechon.iro.umontreal.ca [132.204.27.242]) by pruche.dit.umontreal.ca (8.14.1/8.14.1) with ESMTP id r7KM7j2n002026; Tue, 20 Aug 2013 18:07:45 -0400 Original-Received: by fmsmemgm.homelinux.net (Postfix, from userid 20848) id 71DA7AE1E2; Tue, 20 Aug 2013 18:07:45 -0400 (EDT) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3.50 (gnu/linux) X-NAI-Spam-Flag: NO X-NAI-Spam-Level: X-NAI-Spam-Threshold: 5 X-NAI-Spam-Score: 0.7 X-NAI-Spam-Rules: 3 Rules triggered PHONE_888=0.5, GEN_SPAM_FEATRE=0.2, RV4676=0 X-NAI-Spam-Version: 2.3.0.9362 : core <4676> : streams <1023176> : uri <1512586> X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 132.204.246.22 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:162935 Archived-At: 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 =3D=3D=3D 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 (=3D m 19) + (d (calendar-extract-day bahai-date))) + ;; Can't call calendar-date-string because of monthname oddity. + (calendar--evalconcat + ((monthname (if (and (=3D m 19) (<=3D d 0)) "Ayy=E1m-i-H=E1" (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 ""))))) =20 ;;;###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") =20 @@ -345,13 +346,13 @@ (define-obsolete-function-alias 'insert-yearly-bahai-diary-entry 'diary-bahai-insert-yearly-entry "23.1") =20 -(defvar date) +(defvar diary-date) =20 -;; 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=E1'=ED calendar equivalent of date diary entry." - (format "Bah=E1'=ED date: %s" (calendar-bahai-date-string date))) + (format "Bah=E1'=ED date: %s" (calendar-bahai-date-string diary-date))) =20 =20 (provide 'cal-bahai) =3D=3D=3D 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 degree= s." (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") =20 -(defvar date) +(defvar diary-date) =20 -;; 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))) =20 (provide 'cal-china) =20 =3D=3D=3D 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 "")))) =20 ;;;###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") =20 -(defvar date) +(defvar diary-date) =20 -;; 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)))) =3D=3D=3D 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 @@ =20 (autoload 'calendar-persian-to-absolute "cal-persia") =20 +(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) =3D=3D=3D 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") =20 -(defvar date) +(defvar diary-date) =20 -;; 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)))) =3D=3D=3D 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)))) =20 -(defvar date) +(defvar diary-date) +(defvar diary-entry) =20 -;; 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 da= te))) + (format "Hebrew date (until sunset): %s" + (calendar-hebrew-date-string diary-date))) =20 -(defvar entry) (declare-function diary-ordinal-suffix "diary-lib" (n)) =20 ;;;###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 (=3D b-date d) "" " (evening)"))))) =20 @@ -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 (=3D y d) (=3D y (1+ d)))) (cons mark (format "Yahrzeit of %s%s: %d%s anniversary" - entry + diary-entry (if (=3D y d) "" " (evening)") diff (diary-ordinal-suffix diff)))))) @@ -921,7 +922,7 @@ =20 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 (=3D (% 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 (=3D (% (calendar-absolute-from-gregorian date) 7) 5) ; Friday - (let ((sunset (cadr (solar-sunrise-sunset date)))) + (if (=3D (% (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" =3D=3D=3D 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-bin= ding:t -*- =20 ;; Copyright (C) 2002-2013 Free Software Foundation, Inc. =20 =3D=3D=3D 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 "2= 3.1") =20 -(defvar date) +(defvar diary-date) =20 -;; 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)))) =3D=3D=3D 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") =20 -(defvar date) +(defvar diary-date) =20 -;; 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))) =20 (provide 'cal-iso) =20 =3D=3D=3D 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") =20 -(defvar date) +(defvar diary-date) =20 -;; 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))) =20 -;; 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))) =20 (provide 'cal-julian) =20 =3D=3D=3D 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") =20 -(defvar date) +(defvar diary-date) =20 -;; 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))) =20 (provide 'cal-mayan) =20 =3D=3D=3D 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 -*- =20 ;; Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc. =20 @@ -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. =20 (defun calendar-mouse-view-diary-entries (&optional date diary event) "Pop up menu of diary entries for mouse-selected date. =3D=3D=3D 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 ""))) =20 ;;;###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") =20 -(defvar date) +(defvar diary-date) =20 -;; 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))) =20 (provide 'cal-persia) =20 =3D=3D=3D 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 -*- =20 ;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc. =20 @@ -94,6 +94,8 @@ :group 'calendar-tex) =20 (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) =20 +(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") =20 (autoload 'diary-list-entries "diary-lib") +(defvar diary-list-include-blanks) ;From diary-lib as well. =20 (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 (=3D 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 (=3D 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 (=3D 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) =3D=3D=3D 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 -*- =20 ;; Copyright (C) 1988-1995, 1997, 2000-2013 Free Software Foundation, ;; Inc. @@ -106,15 +106,36 @@ =20 ;; 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 fu= nc +;; diary--file-glob-attrs: yuck =20 ;;; Code: =20 (load "cal-loaddefs" nil t) =20 +(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 "le= ft 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 conte= xt +ENV, while is a let-style list of bindings. SEP is the string to place be= tween +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) =20 @@ -1120,11 +1141,10 @@ (defconst holiday-buffer "*Holidays*" "Name of the buffer used for the displaying the holidays.") =20 +(define-obsolete-variable-alias 'fancy-diary-buffer 'diary-fancy-buffer "2= 3.1") (defconst diary-fancy-buffer "*Fancy Diary Entries*" "Name of the buffer used for the optional fancy display of the diary.") =20 -(define-obsolete-variable-alias 'fancy-diary-buffer 'diary-fancy-buffer "2= 3.1") - (defconst calendar-other-calendars-buffer "*Other Calendars*" "Name of the buffer used for the display of date on other calendars.") =20 @@ -1172,7 +1192,7 @@ (calendar-increment-month mon yr n) (cons mon yr)) =20 -(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) (<=3D (abs (calendar-interval mon yr month yea= r)) 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-sear= ches. - ;; (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)) - (/=3D 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-sea= rches. + ;; (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)) + (/=3D 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)))))) =20 (defun calendar-redraw () "Redraw the calendar display, if `calendar-buffer' is live." @@ -1845,17 +1875,15 @@ =20 (defun calendar-string-spread (strings char length) "Concatenate list of STRINGS separated with copies of CHAR to fill LENGT= H. -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 sh= ort, +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-edge= s)) (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)))) =20 @@ -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 ""))) =20 (defun calendar-dayname-on-or-before (dayname date) "Return the absolute date of the DAYNAME on or before absolute DATE. =3D=3D=3D 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 -*- =20 ;; 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 VAL= UE) 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)) =20 -(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) =20 (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 gda= te) + 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-entrie= s'. Or to `diary-mark-entries'.") =20 +(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-fil= e'. 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'. =20 -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'.) =20 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 d= ate)) 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)) =20 -(defvar original-date) ; bound in diary-list-entries -;(defvar number) ; already declared above =20 (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-strin= g)) @@ -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") =20 -(defvar date-string) ; bound in diary-list-entries =20 (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 "Hol= idays for %s" diary--date-string)) + (insert (mapconcat 'identity holiday= -list "\n"))) + (message "No diary entries for %s" diary--date-string))) + (cons noentries hol-string))) =20 (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))))))) =20 (define-obsolete-function-alias 'simple-diary-display @@ -1066,6 +1073,9 @@ (goto-char (match-beginning 1))))) (message "Unable to locate this diary entry"))))) =20 +(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 fo= rm. 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)))) =20 (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.") =20 -;; 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 (/=3D 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 "2= 3.1") =20 +(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)))) =20 -(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 w= indow @@ -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))))))))) =20 (define-obsolete-function-alias 'mark-sexp-diary-entries @@ -1721,10 +1737,10 @@ =20 %%(SEXP) ENTRY =20 -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. =20 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 @@ =20 ;;; Sexp diary functions. =20 -(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)))) =20 ;; 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 (<=3D date1 d) (<=3D d date2) - (cons mark entry)))) + (cons mark diary-entry)))) =20 ;; 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 t= he ;; first Monday after December 30. For large values of |n| the problem = is ;; more grotesque. - (and (=3D dayname (calendar-day-of-week date)) - (let* ((m (calendar-extract-month date)) - (d (calendar-extract-day date)) - (y (calendar-extract-year date)) + (and (=3D 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 y= 2))) d2))))) - (cons mark entry))))) + (cons mark diary-entry))))) =20 (defun diary-ordinal-suffix (n) "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropria= te.)" @@ -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 (=3D mm 2) (=3D 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)))= ))) =20 ;; 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 (>=3D diff 0) (zerop (% diff n)) - (cons mark (format entry cycle (diary-ordinal-suffix cycle)))))) + (cons mark (format diary-entry cycle (diary-ordinal-suffix cycle)= ))))) =20 (defun diary-day-of-year () "Day of year and number of days remaining in the year of date diary entr= y." - (calendar-day-of-year-string date)) + (calendar-day-of-year-string diary-date)) =20 (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 daynam= e)))) "\\)")) '(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 =3D "[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 =3D "[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. "\\(: .*\\)?")) =20 =3D=3D=3D 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 -*- lexica= l-binding:t -*- =20 ;; 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. =20 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: =20 @@ -452,32 +452,31 @@ =20 ;;; End of user options. =20 +(defvar displayed-month) ; from calendar-generate +(defvar displayed-year) =20 ;; 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-mo= nth. (condition-case err - (eval p) + (eval p) ;; Uses displayed-year and displayed-mon= th. (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))) =20 -(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)))))))))) =20 =20 (defun holiday-advent (&optional n string) =3D=3D=3D 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") =20 -(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)))))) =20 =3D=3D=3D 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 (>=3D 24-hours 12) "pm" "am")) (24-hours (format "%02d" 24-hours))) - (mapconcat 'eval calendar-time-display-form ""))) + calendar-time-display-form ""))) =20 (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)))) =20 (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"))))) =20 -(defvar date) +(defvar diary-date) =20 -;; 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)) =20 ;; From Meeus, 1991, page 167. (defconst solar-seasons-data =3D=3D=3D 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) =20 @@ -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 @@ =20 (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") =20 ;;;###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)))) =20 (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))) =20 -(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)) =20 (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)) =20 (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)) =20 (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)) =20 (defsubst timeclock-day-list-begin (day-list) "Return the start time of DAY-LIST." @@ -865,11 +847,11 @@ =20 (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)) =20 (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)) =20 (defun timeclock-day-list-projects (day-list) "Return a list of all the projects in DAY-LIST."