diff options
| author | Richard M. Stallman | 1997-09-12 19:34:27 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1997-09-12 19:34:27 +0000 |
| commit | 780249f808af3cb9ad451a1b616a119d07d31ba1 (patch) | |
| tree | c71b8eb378f98f907841efdf425d5d8678c529ab | |
| parent | 1ae38812a9b0922cf1423d51f639b91e1cf811ca (diff) | |
| download | emacs-780249f808af3cb9ad451a1b616a119d07d31ba1.tar.gz emacs-780249f808af3cb9ad451a1b616a119d07d31ba1.zip | |
(french-calendar-accents): Change variable to function.
Uses changed. Test that we can display multibyte chars.
(french-calendar-day-name-array, french-calendar-month-name-array):
New functions. Use them instead of directly using these variables.
(french-calendar-multibyte-month-name-array): New variable.
(french-calendar-multibyte-special-days-array): New variable.
(calendar-print-french-date): Bind enable-multibyte-characters to t.
| -rw-r--r-- | lisp/calendar/cal-french.el | 87 |
1 files changed, 54 insertions, 33 deletions
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index d41111b4b7f..43f264f4489 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; cal-french.el --- calendar functions for the French Revolutionary calendar. | 1 | ;;; cal-french.el --- calendar functions for the French Revolutionary calendar. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1988, 1989, 1992, 1994, 1995 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1988, 89, 92, 94, 95, 1997 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | 5 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
| 6 | ;; Keywords: calendar | 6 | ;; Keywords: calendar |
| @@ -43,36 +43,51 @@ | |||
| 43 | 43 | ||
| 44 | (require 'calendar) | 44 | (require 'calendar) |
| 45 | 45 | ||
| 46 | (defvar french-calendar-accents | 46 | (defun french-calendar-accents () |
| 47 | (and (char-table-p standard-display-table) | 47 | "True if diacritical marks are available." |
| 48 | (equal (aref standard-display-table 161) [161])) | 48 | (and (or window-system |
| 49 | "True if diacritical marks are available.") | 49 | (terminal-coding-system)) |
| 50 | (or enable-multibyte-characters | ||
| 51 | (and (char-table-p standard-display-table) | ||
| 52 | (equal (aref standard-display-table 161) [161]))))) | ||
| 50 | 53 | ||
| 51 | (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) | 54 | (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) |
| 52 | "Absolute date of start of French Revolutionary calendar = September 22, 1792.") | 55 | "Absolute date of start of French Revolutionary calendar = September 22, 1792.") |
| 53 | 56 | ||
| 54 | (defconst french-calendar-month-name-array | 57 | (defconst french-calendar-month-name-array |
| 55 | (if french-calendar-accents | 58 | ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" |
| 56 | ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse" | 59 | "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]) |
| 57 | "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"] | 60 | |
| 58 | ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" | 61 | (defconst french-calendar-multibyte-month-name-array |
| 59 | "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"])) | 62 | ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse" |
| 63 | "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"]) | ||
| 60 | 64 | ||
| 61 | (defconst french-calendar-day-name-array | 65 | (defconst french-calendar-day-name-array |
| 62 | ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi" | 66 | ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi" |
| 63 | "Octidi" "Nonidi" "Decadi"]) | 67 | "Octidi" "Nonidi" "Decadi"]) |
| 64 | 68 | ||
| 69 | (defconst french-calendar-multibyte-special-days-array | ||
| 70 | ["de la Vertu" "du Génie" "du Labour" "de la Raison" | ||
| 71 | "de la Récompense" "de la Révolution"]) | ||
| 72 | |||
| 73 | (defun french-calendar-month-name-array () | ||
| 74 | (if (french-calendar-accents) | ||
| 75 | french-calendar-multibyte-month-name-array | ||
| 76 | french-calendar-month-name-array)) | ||
| 77 | |||
| 78 | (defun french-calendar-day-name-array () | ||
| 79 | (if (french-calendar-accents) | ||
| 80 | french-calendar-multibyte-month-name-array | ||
| 81 | french-calendar-month-name-array)) | ||
| 82 | |||
| 65 | (defconst french-calendar-special-days-array | 83 | (defconst french-calendar-special-days-array |
| 66 | (if french-calendar-accents | 84 | ["de la Vertu" "du Ge'nie" "du Labour" "de la Raison" "de la Re'compense" |
| 67 | ["de la Vertu" "du Genie" "du Labour" "de la Raison" | 85 | "de la Re'volution"]) |
| 68 | "de la Récompense" "de la Révolution"] | ||
| 69 | ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Re'compense" | ||
| 70 | "de la Re'volution"])) | ||
| 71 | 86 | ||
| 72 | (defun french-calendar-leap-year-p (year) | 87 | (defun french-calendar-leap-year-p (year) |
| 73 | "True if YEAR is a leap year on the French Revolutionary calendar. | 88 | "True if YEAR is a leap year on the French Revolutionary calendar. |
| 74 | For Gregorian years 1793 to 1805, the years of actual operation of the | 89 | For Gregorian years 1793 to 1805, the years of actual operation of the |
| 75 | calendar, uses historical practice based on equinoxes is followed (years 3, 7, | 90 | calendar, follows historical practice based on equinoxes (years 3, 7, |
| 76 | and 11 were leap years; 15 and 20 would have been leap years). For later | 91 | and 11 were leap years; 15 and 20 would have been leap years). For later |
| 77 | years uses the proposed rule of Romme (never adopted)--leap years fall every | 92 | years uses the proposed rule of Romme (never adopted)--leap years fall every |
| 78 | four years except century years not divisible 400 and century years that are | 93 | four years except century years not divisible 400 and century years that are |
| @@ -153,24 +168,25 @@ Defaults to today's date if DATE is not given." | |||
| 153 | (d (extract-calendar-day french-date))) | 168 | (d (extract-calendar-day french-date))) |
| 154 | (cond | 169 | (cond |
| 155 | ((< y 1) "") | 170 | ((< y 1) "") |
| 156 | ((= m 13) (format (if french-calendar-accents | 171 | ((= m 13) (format (if (french-calendar-accents) |
| 157 | "Jour %s de l'Année %d de la Révolution" | 172 | "Jour %s de l'Année %d de la Révolution" |
| 158 | "Jour %s de l'Anne'e %d de la Re'volution") | 173 | "Jour %s de l'Anne'e %d de la Re'volution") |
| 159 | (aref french-calendar-special-days-array (1- d)) | 174 | (aref french-calendar-special-days-array (1- d)) |
| 160 | y)) | 175 | y)) |
| 161 | (t (format | 176 | (t (format |
| 162 | (if french-calendar-accents | 177 | (if (french-calendar-accents) |
| 163 | "Décade %s, %s de %s de l'Année %d de la Révolution" | 178 | "Décade %s, %s de %s de l'Année %d de la Révolution" |
| 164 | "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution") | 179 | "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution") |
| 165 | (make-string (1+ (/ (1- d) 10)) ?I) | 180 | (make-string (1+ (/ (1- d) 10)) ?I) |
| 166 | (aref french-calendar-day-name-array (% (1- d) 10)) | 181 | (aref (french-calendar-day-name-array) (% (1- d) 10)) |
| 167 | (aref french-calendar-month-name-array (1- m)) | 182 | (aref (french-calendar-month-name-array) (1- m)) |
| 168 | y))))) | 183 | y))))) |
| 169 | 184 | ||
| 170 | (defun calendar-print-french-date () | 185 | (defun calendar-print-french-date () |
| 171 | "Show the French Revolutionary calendar equivalent of the selected date." | 186 | "Show the French Revolutionary calendar equivalent of the selected date." |
| 172 | (interactive) | 187 | (interactive) |
| 173 | (let ((f (calendar-french-date-string (calendar-cursor-to-date t)))) | 188 | (let ((f (calendar-french-date-string (calendar-cursor-to-date t))) |
| 189 | (enable-multibyte-characters t)) | ||
| 174 | (if (string-equal f "") | 190 | (if (string-equal f "") |
| 175 | (message "Date is pre-French Revolution") | 191 | (message "Date is pre-French Revolution") |
| 176 | (message "French Revolutionary date: %s" f)))) | 192 | (message "French Revolutionary date: %s" f)))) |
| @@ -179,19 +195,24 @@ Defaults to today's date if DATE is not given." | |||
| 179 | "Move cursor to French Revolutionary date DATE. | 195 | "Move cursor to French Revolutionary date DATE. |
| 180 | Echo French Revolutionary date unless NOECHO is t." | 196 | Echo French Revolutionary date unless NOECHO is t." |
| 181 | (interactive | 197 | (interactive |
| 182 | (let* ((year (calendar-read | 198 | (let* ((oldval enable-multibyte-characters) |
| 183 | (if french-calendar-accents | 199 | (year (unwind-protect |
| 184 | "Année de la Révolution (>0): " | 200 | (progn |
| 185 | "Anne'e de la Re'volution (>0): ") | 201 | (setq-default enable-multibyte-characters t) |
| 186 | '(lambda (x) (> x 0)) | 202 | (calendar-read |
| 187 | (int-to-string | 203 | (if (french-calendar-accents) |
| 188 | (extract-calendar-year | 204 | "Année de la Révolution (>0): " |
| 189 | (calendar-french-from-absolute | 205 | "Anne'e de la Re'volution (>0): ") |
| 190 | (calendar-absolute-from-gregorian | 206 | '(lambda (x) (> x 0)) |
| 191 | (calendar-current-date))))))) | 207 | (int-to-string |
| 208 | (extract-calendar-year | ||
| 209 | (calendar-french-from-absolute | ||
| 210 | (calendar-absolute-from-gregorian | ||
| 211 | (calendar-current-date))))))) | ||
| 212 | (setq-default enable-multibyte-characters oldval))) | ||
| 192 | (month-list | 213 | (month-list |
| 193 | (mapcar 'list | 214 | (mapcar 'list |
| 194 | (append french-calendar-month-name-array | 215 | (append (french-calendar-month-name-array) |
| 195 | (if (french-calendar-leap-year-p year) | 216 | (if (french-calendar-leap-year-p year) |
| 196 | (mapcar | 217 | (mapcar |
| 197 | '(lambda (x) (concat "Jour " x)) | 218 | '(lambda (x) (concat "Jour " x)) |
| @@ -216,7 +237,7 @@ Echo French Revolutionary date unless NOECHO is t." | |||
| 216 | (decade (if (> month 12) | 237 | (decade (if (> month 12) |
| 217 | 1 | 238 | 1 |
| 218 | (calendar-read | 239 | (calendar-read |
| 219 | (if french-calendar-accents | 240 | (if (french-calendar-accents) |
| 220 | "Décade (1-3): " | 241 | "Décade (1-3): " |
| 221 | "De'cade (1-3): ") | 242 | "De'cade (1-3): ") |
| 222 | '(lambda (x) (memq x '(1 2 3)))))) | 243 | '(lambda (x) (memq x '(1 2 3)))))) |