changeset 5699:a2d78b648542

(calendar-french-date-string): New function. (calendar-print-french-date, diary-french-date): Use it.

--- 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)