diff options
author | Glenn Morris <rgm@gnu.org> | 2008-04-01 02:40:36 +0000 |
---|---|---|
committer | Glenn Morris <rgm@gnu.org> | 2008-04-01 02:40:36 +0000 |
commit | eaf7038ffaa407d8d866416b851cac2400003d58 (patch) | |
tree | f14e1e3ac06b5bca0a17701418c20b67efd649a2 /lisp/calendar/cal-french.el | |
parent | b1c57079fcd1c4c5b63b44a205466dd225efef19 (diff) | |
download | emacs-eaf7038ffaa407d8d866416b851cac2400003d58.tar.gz |
(Commentary): Point to calendar.el.
(calendar-goto-french-date): Reduce nesting of some lets.
Diffstat (limited to 'lisp/calendar/cal-french.el')
-rw-r--r-- | lisp/calendar/cal-french.el | 92 |
1 files changed, 41 insertions, 51 deletions
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index 5190ebc4581..8af5cadc29a 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el @@ -27,15 +27,7 @@ ;;; Commentary: -;; This collection of functions implements the features of calendar.el and -;; diary.el that deal with the French Revolutionary calendar. - -;; Technical details of the French Revolutionary calendar can be found in -;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold -;; and Nachum Dershowitz, Cambridge University Press (2001), and in -;; ``Calendrical Calculations, Part II: Three Historical Calendars'' by -;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, Software--Practice and -;; Experience, Volume 23, Number 4 (April, 1993), pages 383-404. +;; See calendar.el. ;;; Code: @@ -207,49 +199,47 @@ Defaults to today's date if DATE is not given." "Move cursor to French Revolutionary date DATE. Echo French Revolutionary date unless NOECHO is non-nil." (interactive - (let ((accents (french-calendar-accents)) - (months (french-calendar-month-name-array)) - (special-days (french-calendar-special-days-array))) - (let* ((year - (progn - (calendar-read - (if accents - "Année de la Révolution (>0): " - "Anne'e de la Re'volution (>0): ") - (lambda (x) (> x 0)) - (int-to-string - (extract-calendar-year - (calendar-french-from-absolute - (calendar-absolute-from-gregorian - (calendar-current-date)))))))) - (month-list - (mapcar 'list - (append months - (if (french-calendar-leap-year-p year) - (mapcar - (lambda (x) (concat "Jour " x)) - french-calendar-special-days-array) + (let* ((months (french-calendar-month-name-array)) + (special-days (french-calendar-special-days-array)) + (year (progn + (calendar-read + (if (french-calendar-accents) + "Année de la Révolution (>0): " + "Anne'e de la Re'volution (>0): ") + (lambda (x) (> x 0)) + (int-to-string + (extract-calendar-year + (calendar-french-from-absolute + (calendar-absolute-from-gregorian + (calendar-current-date)))))))) + (month-list + (mapcar 'list + (append months + (if (french-calendar-leap-year-p year) + (mapcar + (lambda (x) (concat "Jour " x)) + french-calendar-special-days-array) + (reverse + (cdr ; we don't want rev. day in a non-leap yr (reverse - (cdr ; we don't want rev. day in a non-leap yr - (reverse - (mapcar - (lambda (x) - (concat "Jour " x)) - special-days)))))))) - (completion-ignore-case t) - (month (cdr (assoc-string - (completing-read - "Mois ou Sansculottide: " - month-list - nil t) - (calendar-make-alist month-list 1 'car) t))) - (day (if (> month 12) - (- month 12) - (calendar-read - "Jour (1-30): " - (lambda (x) (and (<= 1 x) (<= x 30)))))) - (month (if (> month 12) 13 month))) - (list (list month day year))))) + (mapcar + (lambda (x) + (concat "Jour " x)) + special-days)))))))) + (completion-ignore-case t) + (month (cdr (assoc-string + (completing-read + "Mois ou Sansculottide: " + month-list + nil t) + (calendar-make-alist month-list 1 'car) t))) + (day (if (> month 12) + (- month 12) + (calendar-read + "Jour (1-30): " + (lambda (x) (and (<= 1 x) (<= x 30)))))) + (month (if (> month 12) 13 month))) + (list (list month day year)))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-french date))) (or noecho (calendar-print-french-date))) |