# HG changeset patch # User Richard M. Stallman # Date 759889772 0 # Node ID a2d78b6485425459f2bbf1577a37782163a05535 # Parent d127e0963a2cb9f17fd3faca373d2162a5eed9d2 (calendar-french-date-string): New function. (calendar-print-french-date, diary-french-date): Use it. diff -r d127e0963a2c -r a2d78b648542 lisp/calendar/cal-french.el --- a/lisp/calendar/cal-french.el Sun Jan 30 00:29:09 1994 +0000 +++ b/lisp/calendar/cal-french.el Sun Jan 30 00:29:32 1994 +0000 @@ -127,27 +127,36 @@ (1- (calendar-absolute-from-french (list month 1 year)))))) (list month day year)))) -(defun calendar-print-french-date () - "Show the French Revolutionary calendar equivalent of the selected date." - (interactive) +(defun calendar-french-date-string (&optional date) + "String of French Revolutionary date of Gregorian DATE. +Returns the empty string if DATE is pre-French Revolutionary. +Defaults to today's date if DATE is not given." (let* ((french-date (calendar-french-from-absolute (calendar-absolute-from-gregorian - (or (calendar-cursor-to-date) - (error "Cursor is not on a date!"))))) + (or date (calendar-current-date))))) (y (extract-calendar-year french-date)) (m (extract-calendar-month french-date)) (d (extract-calendar-day french-date))) - (if (< y 1) + (cond + ((< y 1) "") + ((= m 13) (format "Jour %s de l'Anne'e %d de la Revolution" + (aref french-calendar-special-days-array (1- d)) + y)) + (t (format "Decade %s, %s de %s de l'Anne'e %d de la Revolution" + (make-string (1+ (/ (1- d) 10)) ?I) + (aref french-calendar-day-name-array (% (1- d) 10)) + (aref french-calendar-month-name-array (1- m)) + y))))) + +(defun calendar-print-french-date () + "Show the French Revolutionary calendar equivalent of the selected date." + (interactive) + (let ((f (calendar-french-date-string + (or (calendar-cursor-to-date) + (error "Cursor is not on a date!"))))) + (if (string-equal f "") (message "Date is pre-French Revolution") - (if (= m 13) - (message "Jour %s de l'Anne'e %d de la Revolution" - (aref french-calendar-special-days-array (1- d)) - y) - (message "Decade %s, %s de %s de l'Anne'e %d de la Revolution" - (make-string (1+ (/ (1- d) 10)) ?I) - (aref french-calendar-day-name-array (% (1- d) 10)) - (aref french-calendar-month-name-array (1- m)) - y))))) + (message f)))) (defun calendar-goto-french-date (date &optional noecho) "Move cursor to French Revolutionary date DATE. @@ -204,21 +213,12 @@ (defun diary-french-date () "French calendar equivalent of date diary entry." - (let* ((french-date (calendar-french-from-absolute - (calendar-absolute-from-gregorian date))) - (y (extract-calendar-year french-date)) - (m (extract-calendar-month french-date)) - (d (extract-calendar-day french-date))) - (if (> y 0) - (if (= m 13) - (format "Jour %s de l'Anne'e %d de la Revolution" - (aref french-calendar-special-days-array (1- d)) - y) - (format "Decade %s, %s de %s de l'Anne'e %d de la Revolution" - (make-string (1+ (/ (1- d) 10)) ?I) - (aref french-calendar-day-name-array (% (1- d) 10)) - (aref french-calendar-month-name-array (1- m)) - y))))) + (let ((f (calendar-french-date-string + (or (calendar-cursor-to-date) + (error "Cursor is not on a date!"))))) + (if (string-equal f "") + "Date is pre-French Revolution" + f))) (provide 'cal-french)