diff options
| author | Glenn Morris | 2008-03-14 03:35:03 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-03-14 03:35:03 +0000 |
| commit | c8ca95dd39937818536c9f3c4906ac718a5e1e0c (patch) | |
| tree | 267bed31abd0bbf399ef3476ca5fd6e109f88b4b | |
| parent | 49f64954f584c6b95c5f35f840eb1281ec7db6d9 (diff) | |
| download | emacs-c8ca95dd39937818536c9f3c4906ac718a5e1e0c.tar.gz emacs-c8ca95dd39937818536c9f3c4906ac718a5e1e0c.zip | |
Re-indent.
(calendar-absolute-from-julian): Move definition before use. Remove
un-needed local `day'.
(calendar-goto-julian-date, calendar-goto-astro-day-number): Doc fix.
| -rw-r--r-- | lisp/ChangeLog | 4 | ||||
| -rw-r--r-- | lisp/calendar/cal-julian.el | 75 |
2 files changed, 41 insertions, 38 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 376b158738a..908b04637bc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -38,6 +38,10 @@ | |||
| 38 | (french-calendar-day-name-array, french-calendar-special-days-array): | 38 | (french-calendar-day-name-array, french-calendar-special-days-array): |
| 39 | Add doc strings. | 39 | Add doc strings. |
| 40 | 40 | ||
| 41 | * calendar/cal-julian.el (calendar-absolute-from-julian): Move | ||
| 42 | definition before use. Remove un-needed local `day'. | ||
| 43 | (calendar-goto-julian-date, calendar-goto-astro-day-number): Doc fix. | ||
| 44 | |||
| 41 | * calendar/cal-menu.el (displayed-year): Move declaration where needed. | 45 | * calendar/cal-menu.el (displayed-year): Move declaration where needed. |
| 42 | (calendar-event-to-date, cal-tex-mouse-week, cal-tex-mouse-week-iso): | 46 | (calendar-event-to-date, cal-tex-mouse-week, cal-tex-mouse-week-iso): |
| 43 | Doc fix. | 47 | Doc fix. |
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el index 05dd01e4812..abe66a0e950 100644 --- a/lisp/calendar/cal-julian.el +++ b/lisp/calendar/cal-julian.el | |||
| @@ -38,6 +38,20 @@ | |||
| 38 | 38 | ||
| 39 | (require 'calendar) | 39 | (require 'calendar) |
| 40 | 40 | ||
| 41 | (defun calendar-absolute-from-julian (date) | ||
| 42 | "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. | ||
| 43 | The Gregorian date Sunday, December 31, 1 BC is imaginary." | ||
| 44 | (let ((month (extract-calendar-month date)) | ||
| 45 | (year (extract-calendar-year date))) | ||
| 46 | (+ (calendar-day-number date) | ||
| 47 | (if (and (zerop (% year 100)) | ||
| 48 | (not (zerop (% year 400))) | ||
| 49 | (> month 2)) | ||
| 50 | 1 0) ; correct for Julian but not Gregorian leap year | ||
| 51 | (* 365 (1- year)) | ||
| 52 | (/ (1- year) 4) | ||
| 53 | -2))) | ||
| 54 | |||
| 41 | ;;;###cal-autoload | 55 | ;;;###cal-autoload |
| 42 | (defun calendar-julian-from-absolute (date) | 56 | (defun calendar-julian-from-absolute (date) |
| 43 | "Compute the Julian (month day year) corresponding to the absolute DATE. | 57 | "Compute the Julian (month day year) corresponding to the absolute DATE. |
| @@ -47,38 +61,25 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 47 | (year ; search forward from the approximation | 61 | (year ; search forward from the approximation |
| 48 | (+ approx | 62 | (+ approx |
| 49 | (calendar-sum y approx | 63 | (calendar-sum y approx |
| 50 | (>= date (calendar-absolute-from-julian (list 1 1 (1+ y)))) | 64 | (>= date (calendar-absolute-from-julian |
| 51 | 1))) | 65 | (list 1 1 (1+ y)))) |
| 66 | 1))) | ||
| 52 | (month ; search forward from January | 67 | (month ; search forward from January |
| 53 | (1+ (calendar-sum m 1 | 68 | (1+ (calendar-sum m 1 |
| 54 | (> date | 69 | (> date |
| 55 | (calendar-absolute-from-julian | 70 | (calendar-absolute-from-julian |
| 56 | (list m | 71 | (list m |
| 57 | (if (and (= m 2) (zerop (% year 4))) | 72 | (if (and (= m 2) (zerop (% year 4))) |
| 58 | 29 | 73 | 29 |
| 59 | (aref [31 28 31 30 31 30 31 31 30 31 30 31] | 74 | (aref [31 28 31 30 31 30 31 |
| 60 | (1- m))) | 75 | 31 30 31 30 31] |
| 61 | year))) | 76 | (1- m))) |
| 62 | 1))) | 77 | year))) |
| 78 | 1))) | ||
| 63 | (day ; calculate the day by subtraction | 79 | (day ; calculate the day by subtraction |
| 64 | (- date (1- (calendar-absolute-from-julian (list month 1 year)))))) | 80 | (- date (1- (calendar-absolute-from-julian (list month 1 year)))))) |
| 65 | (list month day year))) | 81 | (list month day year))) |
| 66 | 82 | ||
| 67 | (defun calendar-absolute-from-julian (date) | ||
| 68 | "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. | ||
| 69 | The Gregorian date Sunday, December 31, 1 BC is imaginary." | ||
| 70 | (let ((month (extract-calendar-month date)) | ||
| 71 | (day (extract-calendar-day date)) | ||
| 72 | (year (extract-calendar-year date))) | ||
| 73 | (+ (calendar-day-number date) | ||
| 74 | (if (and (zerop (% year 100)) | ||
| 75 | (/= (% year 400) 0) | ||
| 76 | (> month 2)) | ||
| 77 | 1 0) ; correct for Julian but not Gregorian leap year | ||
| 78 | (* 365 (1- year)) | ||
| 79 | (/ (1- year) 4) | ||
| 80 | -2))) | ||
| 81 | |||
| 82 | ;;;###cal-autoload | 83 | ;;;###cal-autoload |
| 83 | (defun calendar-julian-date-string (&optional date) | 84 | (defun calendar-julian-date-string (&optional date) |
| 84 | "String of Julian date of Gregorian DATE. | 85 | "String of Julian date of Gregorian DATE. |
| @@ -86,8 +87,7 @@ Defaults to today's date if DATE is not given. | |||
| 86 | Driven by the variable `calendar-date-display-form'." | 87 | Driven by the variable `calendar-date-display-form'." |
| 87 | (calendar-date-string | 88 | (calendar-date-string |
| 88 | (calendar-julian-from-absolute | 89 | (calendar-julian-from-absolute |
| 89 | (calendar-absolute-from-gregorian | 90 | (calendar-absolute-from-gregorian (or date (calendar-current-date)))) |
| 90 | (or date (calendar-current-date)))) | ||
| 91 | nil t)) | 91 | nil t)) |
| 92 | 92 | ||
| 93 | ;;;###cal-autoload | 93 | ;;;###cal-autoload |
| @@ -99,7 +99,7 @@ Driven by the variable `calendar-date-display-form'." | |||
| 99 | 99 | ||
| 100 | ;;;###cal-autoload | 100 | ;;;###cal-autoload |
| 101 | (defun calendar-goto-julian-date (date &optional noecho) | 101 | (defun calendar-goto-julian-date (date &optional noecho) |
| 102 | "Move cursor to Julian DATE; echo Julian date unless NOECHO is t." | 102 | "Move cursor to Julian DATE; echo Julian date unless NOECHO is non-nil." |
| 103 | (interactive | 103 | (interactive |
| 104 | (let* ((today (calendar-current-date)) | 104 | (let* ((today (calendar-current-date)) |
| 105 | (year (calendar-read | 105 | (year (calendar-read |
| @@ -113,10 +113,10 @@ Driven by the variable `calendar-date-display-form'." | |||
| 113 | (month-array calendar-month-name-array) | 113 | (month-array calendar-month-name-array) |
| 114 | (completion-ignore-case t) | 114 | (completion-ignore-case t) |
| 115 | (month (cdr (assoc-string | 115 | (month (cdr (assoc-string |
| 116 | (completing-read | 116 | (completing-read |
| 117 | "Julian calendar month name: " | 117 | "Julian calendar month name: " |
| 118 | (mapcar 'list (append month-array nil)) | 118 | (mapcar 'list (append month-array nil)) |
| 119 | nil t) | 119 | nil t) |
| 120 | (calendar-make-alist month-array 1) t))) | 120 | (calendar-make-alist month-array 1) t))) |
| 121 | (last | 121 | (last |
| 122 | (if (and (zerop (% year 4)) (= month 2)) | 122 | (if (and (zerop (% year 4)) (= month 2)) |
| @@ -126,8 +126,8 @@ Driven by the variable `calendar-date-display-form'." | |||
| 126 | (format "Julian calendar day (%d-%d): " | 126 | (format "Julian calendar day (%d-%d): " |
| 127 | (if (and (= year 1) (= month 1)) 3 1) last) | 127 | (if (and (= year 1) (= month 1)) 3 1) last) |
| 128 | (lambda (x) | 128 | (lambda (x) |
| 129 | (and (< (if (and (= year 1) (= month 1)) 2 0) x) | 129 | (and (< (if (and (= year 1) (= month 1)) 2 0) x) |
| 130 | (<= x last)))))) | 130 | (<= x last)))))) |
| 131 | (list (list month day year)))) | 131 | (list (list month day year)))) |
| 132 | (calendar-goto-date (calendar-gregorian-from-absolute | 132 | (calendar-goto-date (calendar-gregorian-from-absolute |
| 133 | (calendar-absolute-from-julian date))) | 133 | (calendar-absolute-from-julian date))) |
| @@ -181,8 +181,7 @@ Defaults to today's date if DATE is not given." | |||
| 181 | (int-to-string | 181 | (int-to-string |
| 182 | (ceiling | 182 | (ceiling |
| 183 | (calendar-astro-from-absolute | 183 | (calendar-astro-from-absolute |
| 184 | (calendar-absolute-from-gregorian | 184 | (calendar-absolute-from-gregorian (or date (calendar-current-date))))))) |
| 185 | (or date (calendar-current-date))))))) | ||
| 186 | 185 | ||
| 187 | ;;;###cal-autoload | 186 | ;;;###cal-autoload |
| 188 | (defun calendar-print-astro-day-number () | 187 | (defun calendar-print-astro-day-number () |
| @@ -195,7 +194,7 @@ Defaults to today's date if DATE is not given." | |||
| 195 | ;;;###cal-autoload | 194 | ;;;###cal-autoload |
| 196 | (defun calendar-goto-astro-day-number (daynumber &optional noecho) | 195 | (defun calendar-goto-astro-day-number (daynumber &optional noecho) |
| 197 | "Move cursor to astronomical (Julian) DAYNUMBER. | 196 | "Move cursor to astronomical (Julian) DAYNUMBER. |
| 198 | Echo astronomical (Julian) day number unless NOECHO is t." | 197 | Echo astronomical (Julian) day number unless NOECHO is non-nil." |
| 199 | (interactive (list (calendar-read | 198 | (interactive (list (calendar-read |
| 200 | "Astronomical (Julian) day number (>1721425): " | 199 | "Astronomical (Julian) day number (>1721425): " |
| 201 | (lambda (x) (> x 1721425))))) | 200 | (lambda (x) (> x 1721425))))) |