[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Patches to calendar
|
From: |
Emilio Lopes |
|
Subject: |
Patches to calendar |
|
Date: |
Sat, 18 Sep 2004 23:09:26 +0200 |
|
User-agent: |
Emacs Gnus |
Here are the patches to calendar as discussed with Ed Reingold.
Besides the new command `calendar-goto-iso-week' I also
unquoted all the lambda forms in the code, as suggested by
Stefan Monnier.
2004-09-18 Ed Reingold <address@hidden> and Emilio C. Lopes <address@hidden>
* calendar/cal-iso.el (calendar-goto-iso-week): New command.
* calendar/calendar.el (calendar-goto-iso-week): Added autoload.
* calendar/calendar.el (calendar-mode-map):
* calendar/cal-menu.el (calendar-mode-map): Added bindings for
`calendar-goto-iso-week'.
* calendar/cal-iso.el (calendar-goto-iso-date):
* calendar/calendar.el (mark-visible-calendar-date):
* calendar/cal-tex.el (cal-tex-hook)
(cal-tex-latexify-list):
* calendar/cal-persia.el (persian-prompt-for-date):
* calendar/cal-move.el (calendar-goto-day-of-year):
* calendar/cal-menu.el (calendar-mouse-holidays)
(calendar-mouse-view-diary-entries):
* calendar/cal-mayan.el (calendar-read-mayan-haab-date)
(calendar-read-mayan-tzolkin-date):
* calendar/cal-julian.el (calendar-goto-julian-date)
(calendar-goto-astro-day-number):
* calendar/cal-islam.el (calendar-goto-islamic-date):
* calendar/cal-hebrew.el (calendar-goto-hebrew-date)
(list-yahrzeit-dates):
* calendar/cal-french.el (calendar-goto-french-date):
* calendar/cal-coptic.el (coptic-prompt-for-date):
* calendar/cal-china.el (calendar-goto-chinese-date)
(chinese-months):
* calendar/cal-bahai.el (mark-bahai-diary-entries)
(bahai-prompt-for-date): unquoted `lambda' forms
Index: lisp/calendar/cal-bahai.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-bahai.el,v
retrieving revision 1.6
diff -c -r1.6 cal-bahai.el
*** lisp/calendar/cal-bahai.el 9 May 2004 04:52:07 -0000 1.6
--- lisp/calendar/cal-bahai.el 18 Sep 2004 20:12:36 -0000
***************
*** 155,176 ****
(let* ((today (calendar-current-date))
(year (calendar-read
"Baha'i calendar year (not 0): "
! '(lambda (x) (/= x 0))
(int-to-string
(extract-calendar-year
(calendar-bahai-from-absolute
(calendar-absolute-from-gregorian today))))))
(completion-ignore-case t)
(month (cdr (assoc
! (completing-read
! "Baha'i calendar month name: "
! (mapcar 'list
! (append bahai-calendar-month-name-array nil))
! nil t)
(calendar-make-alist bahai-calendar-month-name-array
1))))
(day (calendar-read "Baha'i calendar day (1-19): "
! '(lambda (x) (and (< 0 x) (<= x 19))))))
(list (list month day year))))
(defun diary-bahai-date ()
--- 155,176 ----
(let* ((today (calendar-current-date))
(year (calendar-read
"Baha'i calendar year (not 0): "
! (lambda (x) (/= x 0))
(int-to-string
(extract-calendar-year
(calendar-bahai-from-absolute
(calendar-absolute-from-gregorian today))))))
(completion-ignore-case t)
(month (cdr (assoc
! (completing-read
! "Baha'i calendar month name: "
! (mapcar 'list
! (append bahai-calendar-month-name-array nil))
! nil t)
(calendar-make-alist bahai-calendar-month-name-array
1))))
(day (calendar-read "Baha'i calendar day (1-19): "
! (lambda (x) (and (< 0 x) (<= x 19))))))
(list (list month day year))))
(defun diary-bahai-date ()
***************
*** 379,385 ****
(calendar-make-alist
calendar-day-name-array
0
! '(lambda (x) (substring x 0 3))))))
(if mm-name
(if (string-equal mm-name "*")
(setq mm 0)
--- 379,385 ----
(calendar-make-alist
calendar-day-name-array
0
! (lambda (x) (substring x 0 3))))))
(if mm-name
(if (string-equal mm-name "*")
(setq mm 0)
Index: lisp/calendar/cal-china.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-china.el,v
retrieving revision 1.18
diff -c -r1.18 cal-china.el
*** lisp/calendar/cal-china.el 1 Sep 2003 15:45:19 -0000 1.18
--- lisp/calendar/cal-china.el 18 Sep 2004 20:12:38 -0000
***************
*** 434,444 ****
(calendar-current-date))))
(cycle (calendar-read
"Chinese calendar cycle number (>44): "
! '(lambda (x) (> x 44))
(int-to-string (car c))))
(year (calendar-read
"Year in Chinese cycle (1..60): "
! '(lambda (x) (and (<= 1 x) (<= x 60)))
(int-to-string (car (cdr c)))))
(month-list (make-chinese-month-assoc-list
(chinese-months cycle year)))
--- 434,444 ----
(calendar-current-date))))
(cycle (calendar-read
"Chinese calendar cycle number (>44): "
! (lambda (x) (> x 44))
(int-to-string (car c))))
(year (calendar-read
"Year in Chinese cycle (1..60): "
! (lambda (x) (and (<= 1 x) (<= x 60)))
(int-to-string (car (cdr c)))))
(month-list (make-chinese-month-assoc-list
(chinese-months cycle year)))
***************
*** 456,462 ****
29))
(day (calendar-read
(format "Chinese calendar day (1-%d): " last)
! '(lambda (x) (and (<= 1 x) (<= x last))))))
(list (list cycle year month day))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-chinese date)))
--- 456,462 ----
29))
(day (calendar-read
(format "Chinese calendar day (1-%d): " last)
! (lambda (x) (and (<= 1 x) (<= x last))))))
(list (list cycle year month day))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-chinese date)))
***************
*** 465,478 ****
(defun chinese-months (c y)
"A list of the months in cycle C, year Y of the Chinese calendar."
(let* ((l (memq 1 (append
! (mapcar '(lambda (x)
! (car x))
(chinese-year (extract-calendar-year
(calendar-gregorian-from-absolute
(calendar-absolute-from-chinese
(list c y 1 1))))))
! (mapcar '(lambda (x)
! (if (> (car x) 11) (car x)))
(chinese-year (extract-calendar-year
(calendar-gregorian-from-absolute
(calendar-absolute-from-chinese
--- 465,478 ----
(defun chinese-months (c y)
"A list of the months in cycle C, year Y of the Chinese calendar."
(let* ((l (memq 1 (append
! (mapcar (lambda (x)
! (car x))
(chinese-year (extract-calendar-year
(calendar-gregorian-from-absolute
(calendar-absolute-from-chinese
(list c y 1 1))))))
! (mapcar (lambda (x)
! (if (> (car x) 11) (car x)))
(chinese-year (extract-calendar-year
(calendar-gregorian-from-absolute
(calendar-absolute-from-chinese
Index: lisp/calendar/cal-coptic.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-coptic.el,v
retrieving revision 1.14
diff -c -r1.14 cal-coptic.el
*** lisp/calendar/cal-coptic.el 19 Feb 2004 01:15:03 -0000 1.14
--- lisp/calendar/cal-coptic.el 18 Sep 2004 20:12:38 -0000
***************
*** 145,151 ****
(let* ((today (calendar-current-date))
(year (calendar-read
(format "%s calendar year (>0): " coptic-name)
! '(lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-coptic-from-absolute
--- 145,151 ----
(let* ((today (calendar-current-date))
(year (calendar-read
(format "%s calendar year (>0): " coptic-name)
! (lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-coptic-from-absolute
***************
*** 162,168 ****
(last (coptic-calendar-last-day-of-month month year))
(day (calendar-read
(format "%s calendar day (1-%d): " coptic-name last)
! '(lambda (x) (and (< 0 x) (<= x last))))))
(list (list month day year))))
(defun diary-coptic-date ()
--- 162,168 ----
(last (coptic-calendar-last-day-of-month month year))
(day (calendar-read
(format "%s calendar day (1-%d): " coptic-name last)
! (lambda (x) (and (< 0 x) (<= x last))))))
(list (list month day year))))
(defun diary-coptic-date ()
Index: lisp/calendar/cal-french.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-french.el,v
retrieving revision 1.27
diff -c -r1.27 cal-french.el
*** lisp/calendar/cal-french.el 19 Feb 2004 01:15:40 -0000 1.27
--- lisp/calendar/cal-french.el 18 Sep 2004 20:12:39 -0000
***************
*** 206,213 ****
(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
--- 206,213 ----
(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
***************
*** 218,231 ****
(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
(mapcar
! '(lambda (x)
! (concat "Jour " x))
special-days))))))))
(completion-ignore-case t)
(month (cdr (assoc-string
--- 218,231 ----
(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
(mapcar
! (lambda (x)
! (concat "Jour " x))
special-days))))))))
(completion-ignore-case t)
(month (cdr (assoc-string
***************
*** 238,244 ****
(- 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
--- 238,244 ----
(- 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
Index: lisp/calendar/cal-hebrew.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-hebrew.el,v
retrieving revision 1.18
diff -c -r1.18 cal-hebrew.el
*** lisp/calendar/cal-hebrew.el 19 Feb 2004 01:16:53 -0000 1.18
--- lisp/calendar/cal-hebrew.el 18 Sep 2004 20:12:43 -0000
***************
*** 227,233 ****
(let* ((today (calendar-current-date))
(year (calendar-read
"Hebrew calendar year (>3760): "
! '(lambda (x) (> x 3760))
(int-to-string
(extract-calendar-year
(calendar-hebrew-from-absolute
--- 227,233 ----
(let* ((today (calendar-current-date))
(year (calendar-read
"Hebrew calendar year (>3760): "
! (lambda (x) (> x 3760))
(int-to-string
(extract-calendar-year
(calendar-hebrew-from-absolute
***************
*** 241,258 ****
"Hebrew calendar month name: "
(mapcar 'list (append month-array nil))
(if (= year 3761)
! '(lambda (x)
! (let ((m (cdr
! (assoc-string
! (car x)
! (calendar-make-alist month-array)
! t))))
! (< 0
! (calendar-absolute-from-hebrew
! (list m
! (hebrew-calendar-last-day-of-month
! m year)
! year))))))
t)
(calendar-make-alist month-array 1) t)))
(last (hebrew-calendar-last-day-of-month month year))
--- 241,258 ----
"Hebrew calendar month name: "
(mapcar 'list (append month-array nil))
(if (= year 3761)
! (lambda (x)
! (let ((m (cdr
! (assoc-string
! (car x)
! (calendar-make-alist month-array)
! t))))
! (< 0
! (calendar-absolute-from-hebrew
! (list m
! (hebrew-calendar-last-day-of-month
! m year)
! year))))))
t)
(calendar-make-alist month-array 1) t)))
(last (hebrew-calendar-last-day-of-month month year))
***************
*** 261,267 ****
(day (calendar-read
(format "Hebrew calendar day (%d-%d): "
first last)
! '(lambda (x) (and (<= first x) (<= x last))))))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-hebrew date)))
--- 261,267 ----
(day (calendar-read
(format "Hebrew calendar day (%d-%d): "
first last)
! (lambda (x) (and (<= first x) (<= x last))))))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-hebrew date)))
***************
*** 835,841 ****
(let* ((today (calendar-current-date))
(year (calendar-read
"Year of death (>0): "
! '(lambda (x) (> x 0))
(int-to-string (extract-calendar-year today))))
(month-array calendar-month-name-array)
(completion-ignore-case t)
--- 835,841 ----
(let* ((today (calendar-current-date))
(year (calendar-read
"Year of death (>0): "
! (lambda (x) (> x 0))
(int-to-string (extract-calendar-year today))))
(month-array calendar-month-name-array)
(completion-ignore-case t)
***************
*** 848,865 ****
(last (calendar-last-day-of-month month year))
(day (calendar-read
(format "Day of death (1-%d): " last)
! '(lambda (x) (and (< 0 x) (<= x last))))))
(list month day year))))
(death-year (extract-calendar-year death-date))
(start-year (calendar-read
(format "Starting year of Yahrzeit table (>%d): "
death-year)
! '(lambda (x) (> x death-year))
(int-to-string (1+ death-year))))
(end-year (calendar-read
(format "Ending year of Yahrzeit table (>=%d): "
start-year)
! '(lambda (x) (>= x start-year)))))
(list death-date start-year end-year)))
(message "Computing yahrzeits...")
(let* ((yahrzeit-buffer "*Yahrzeits*")
--- 848,865 ----
(last (calendar-last-day-of-month month year))
(day (calendar-read
(format "Day of death (1-%d): " last)
! (lambda (x) (and (< 0 x) (<= x last))))))
(list month day year))))
(death-year (extract-calendar-year death-date))
(start-year (calendar-read
(format "Starting year of Yahrzeit table (>%d): "
death-year)
! (lambda (x) (> x death-year))
(int-to-string (1+ death-year))))
(end-year (calendar-read
(format "Ending year of Yahrzeit table (>=%d): "
start-year)
! (lambda (x) (>= x start-year)))))
(list death-date start-year end-year)))
(message "Computing yahrzeits...")
(let* ((yahrzeit-buffer "*Yahrzeits*")
Index: lisp/calendar/cal-islam.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-islam.el,v
retrieving revision 1.14
diff -c -r1.14 cal-islam.el
*** lisp/calendar/cal-islam.el 19 Feb 2004 01:17:44 -0000 1.14
--- lisp/calendar/cal-islam.el 18 Sep 2004 20:12:45 -0000
***************
*** 147,153 ****
(let* ((today (calendar-current-date))
(year (calendar-read
"Islamic calendar year (>0): "
! '(lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-islamic-from-absolute
--- 147,153 ----
(let* ((today (calendar-current-date))
(year (calendar-read
"Islamic calendar year (>0): "
! (lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-islamic-from-absolute
***************
*** 163,169 ****
(last (islamic-calendar-last-day-of-month month year))
(day (calendar-read
(format "Islamic calendar day (1-%d): " last)
! '(lambda (x) (and (< 0 x) (<= x last))))))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-islamic date)))
--- 163,169 ----
(last (islamic-calendar-last-day-of-month month year))
(day (calendar-read
(format "Islamic calendar day (1-%d): " last)
! (lambda (x) (and (< 0 x) (<= x last))))))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-islamic date)))
Index: lisp/calendar/cal-iso.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-iso.el,v
retrieving revision 1.6
diff -c -r1.6 cal-iso.el
*** lisp/calendar/cal-iso.el 1 Sep 2003 15:45:19 -0000 1.6
--- lisp/calendar/cal-iso.el 18 Sep 2004 20:12:45 -0000
***************
*** 102,108 ****
(let* ((today (calendar-current-date))
(year (calendar-read
"ISO calendar year (>0): "
! '(lambda (x) (> x 0))
(int-to-string (extract-calendar-year today))))
(no-weeks (extract-calendar-month
(calendar-iso-from-absolute
--- 102,108 ----
(let* ((today (calendar-current-date))
(year (calendar-read
"ISO calendar year (>0): "
! (lambda (x) (> x 0))
(int-to-string (extract-calendar-year today))))
(no-weeks (extract-calendar-month
(calendar-iso-from-absolute
***************
*** 112,126 ****
(list 1 4 (1+ year))))))))
(week (calendar-read
(format "ISO calendar week (1-%d): " no-weeks)
! '(lambda (x) (and (> x 0) (<= x no-weeks)))))
(day (calendar-read
"ISO day (1-7): "
! '(lambda (x) (and (<= 1 x) (<= x 7))))))
(list (list week day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-iso date)))
(or noecho (calendar-print-iso-date)))
(defun diary-iso-date ()
"ISO calendar equivalent of date diary entry."
(format "ISO date: %s" (calendar-iso-date-string date)))
--- 112,148 ----
(list 1 4 (1+ year))))))))
(week (calendar-read
(format "ISO calendar week (1-%d): " no-weeks)
! (lambda (x) (and (> x 0) (<= x no-weeks)))))
(day (calendar-read
"ISO day (1-7): "
! (lambda (x) (and (<= 1 x) (<= x 7))))))
(list (list week day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-iso date)))
(or noecho (calendar-print-iso-date)))
+ (defun calendar-goto-iso-week (week year &optional noecho)
+ "Move cursor to start of ISO WEEK in YEAR; echo ISO date unless NOECHO is
t."
+ (interactive
+ (let* ((today (calendar-current-date))
+ (year (calendar-read
+ "ISO calendar year (>0): "
+ (lambda (x) (> x 0))
+ (int-to-string (extract-calendar-year today))))
+ (no-weeks (extract-calendar-month
+ (calendar-iso-from-absolute
+ (1-
+ (calendar-dayname-on-or-before
+ 1 (calendar-absolute-from-gregorian
+ (list 1 4 (1+ year))))))))
+ (week (calendar-read
+ (format "ISO calendar week (1-%d): " no-weeks)
+ (lambda (x) (and (> x 0) (<= x no-weeks))))))
+ (list week year)))
+ (calendar-goto-date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-iso (list week 1 year))))
+ (or noecho (calendar-print-iso-date)))
+
(defun diary-iso-date ()
"ISO calendar equivalent of date diary entry."
(format "ISO date: %s" (calendar-iso-date-string date)))
Index: lisp/calendar/cal-julian.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-julian.el,v
retrieving revision 1.12
diff -c -r1.12 cal-julian.el
*** lisp/calendar/cal-julian.el 19 Feb 2004 01:18:23 -0000 1.12
--- lisp/calendar/cal-julian.el 18 Sep 2004 20:12:46 -0000
***************
*** 107,113 ****
(let* ((today (calendar-current-date))
(year (calendar-read
"Julian calendar year (>0): "
! '(lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-julian-from-absolute
--- 107,113 ----
(let* ((today (calendar-current-date))
(year (calendar-read
"Julian calendar year (>0): "
! (lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-julian-from-absolute
***************
*** 116,125 ****
(month-array calendar-month-name-array)
(completion-ignore-case t)
(month (cdr (assoc-string
! (completing-read
! "Julian calendar month name: "
! (mapcar 'list (append month-array nil))
! nil t)
(calendar-make-alist month-array 1) t)))
(last
(if (and (zerop (% year 4)) (= month 2))
--- 116,125 ----
(month-array calendar-month-name-array)
(completion-ignore-case t)
(month (cdr (assoc-string
! (completing-read
! "Julian calendar month name: "
! (mapcar 'list (append month-array nil))
! nil t)
(calendar-make-alist month-array 1) t)))
(last
(if (and (zerop (% year 4)) (= month 2))
***************
*** 128,136 ****
(day (calendar-read
(format "Julian calendar day (%d-%d): "
(if (and (= year 1) (= month 1)) 3 1) last)
! '(lambda (x)
! (and (< (if (and (= year 1) (= month 1)) 2 0) x)
! (<= x last))))))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-julian date)))
--- 128,136 ----
(day (calendar-read
(format "Julian calendar day (%d-%d): "
(if (and (= year 1) (= month 1)) 3 1) last)
! (lambda (x)
! (and (< (if (and (= year 1) (= month 1)) 2 0) x)
! (<= x last))))))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-julian date)))
***************
*** 196,202 ****
Echo astronomical (Julian) day number unless NOECHO is t."
(interactive (list (calendar-read
"Astronomical (Julian) day number (>1721425): "
! '(lambda (x) (> x 1721425)))))
(calendar-goto-date
(calendar-gregorian-from-absolute
(floor
--- 196,202 ----
Echo astronomical (Julian) day number unless NOECHO is t."
(interactive (list (calendar-read
"Astronomical (Julian) day number (>1721425): "
! (lambda (x) (> x 1721425)))))
(calendar-goto-date
(calendar-gregorian-from-absolute
(floor
Index: lisp/calendar/cal-mayan.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-mayan.el,v
retrieving revision 1.22
diff -c -r1.22 cal-mayan.el
*** lisp/calendar/cal-mayan.el 19 Feb 2004 01:19:05 -0000 1.22
--- lisp/calendar/cal-mayan.el 18 Sep 2004 20:12:47 -0000
***************
*** 252,258 ****
(let* ((completion-ignore-case t)
(haab-day (calendar-read
"Haab kin (0-19): "
! '(lambda (x) (and (>= x 0) (< x 20)))))
(haab-month-list (append calendar-mayan-haab-month-name-array
(and (< haab-day 5) '("Uayeb"))))
(haab-month (cdr
--- 252,258 ----
(let* ((completion-ignore-case t)
(haab-day (calendar-read
"Haab kin (0-19): "
! (lambda (x) (and (>= x 0) (< x 20)))))
(haab-month-list (append calendar-mayan-haab-month-name-array
(and (< haab-day 5) '("Uayeb"))))
(haab-month (cdr
***************
*** 268,274 ****
(let* ((completion-ignore-case t)
(tzolkin-count (calendar-read
"Tzolkin kin (1-13): "
! '(lambda (x) (and (> x 0) (< x 14)))))
(tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
(tzolkin-name (cdr
(assoc-string
--- 268,274 ----
(let* ((completion-ignore-case t)
(tzolkin-count (calendar-read
"Tzolkin kin (1-13): "
! (lambda (x) (and (> x 0) (< x 14)))))
(tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
(tzolkin-name (cdr
(assoc-string
Index: lisp/calendar/cal-menu.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-menu.el,v
retrieving revision 1.54
diff -c -r1.54 cal-menu.el
*** lisp/calendar/cal-menu.el 8 May 2004 12:42:07 -0000 1.54
--- lisp/calendar/cal-menu.el 18 Sep 2004 20:12:48 -0000
***************
*** 119,124 ****
--- 119,126 ----
'("Hebrew Date" . calendar-goto-hebrew-date))
(define-key calendar-mode-map [menu-bar goto astro]
'("Astronomical Date" . calendar-goto-astro-day-number))
+ (define-key calendar-mode-map [menu-bar goto iso-week]
+ '("ISO Week" . calendar-goto-iso-week))
(define-key calendar-mode-map [menu-bar goto iso]
'("ISO Date" . calendar-goto-iso-date))
(define-key calendar-mode-map [menu-bar goto day-of-year]
***************
*** 323,329 ****
"Pop up menu of holidays for mouse selected date."
(interactive)
(let* ((date (calendar-event-to-date))
! (l (mapcar '(lambda (x) (list x))
(check-calendar-holidays date)))
(selection
(cal-menu-x-popup-menu
--- 325,331 ----
"Pop up menu of holidays for mouse selected date."
(interactive)
(let* ((date (calendar-event-to-date))
! (l (mapcar (lambda (x) (list x))
(check-calendar-holidays date)))
(selection
(cal-menu-x-popup-menu
***************
*** 346,355 ****
(diary-list-include-blanks nil)
(diary-display-hook 'ignore)
(diary-entries
! (mapcar '(lambda (x) (split-string (car (cdr x)) "\^M\\|\n"))
(list-diary-entries date 1)))
(holidays (if holidays-in-diary-buffer
! (mapcar '(lambda (x) (list x))
(check-calendar-holidays date))))
(title (concat "Diary entries "
(if diary (format "from %s " diary) "")
--- 348,357 ----
(diary-list-include-blanks nil)
(diary-display-hook 'ignore)
(diary-entries
! (mapcar (lambda (x) (split-string (car (cdr x)) "\^M\\|\n"))
(list-diary-entries date 1)))
(holidays (if holidays-in-diary-buffer
! (mapcar (lambda (x) (list x))
(check-calendar-holidays date))))
(title (concat "Diary entries "
(if diary (format "from %s " diary) "")
***************
*** 362,368 ****
(append
(list title)
(if holidays
! (mapcar '(lambda (x) (list (concat " " (car x))))
holidays))
(if holidays
(list "--shadow-etched-in" "--shadow-etched-in"))
--- 364,370 ----
(append
(list title)
(if holidays
! (mapcar (lambda (x) (list (concat " " (car x))))
holidays))
(if holidays
(list "--shadow-etched-in" "--shadow-etched-in"))
Index: lisp/calendar/cal-move.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-move.el,v
retrieving revision 1.9
diff -c -r1.9 cal-move.el
*** lisp/calendar/cal-move.el 1 Sep 2003 15:45:19 -0000 1.9
--- lisp/calendar/cal-move.el 18 Sep 2004 20:12:49 -0000
***************
*** 339,345 ****
(last (if (calendar-leap-year-p year) 366 365))
(day (calendar-read
(format "Day number (+/- 1-%d): " last)
! '(lambda (x) (and (<= 1 (abs x)) (<= (abs x) last))))))
(list year day)))
(calendar-goto-date
(calendar-gregorian-from-absolute
--- 339,345 ----
(last (if (calendar-leap-year-p year) 366 365))
(day (calendar-read
(format "Day number (+/- 1-%d): " last)
! (lambda (x) (and (<= 1 (abs x)) (<= (abs x) last))))))
(list year day)))
(calendar-goto-date
(calendar-gregorian-from-absolute
Index: lisp/calendar/cal-persia.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-persia.el,v
retrieving revision 1.8
diff -c -r1.8 cal-persia.el
*** lisp/calendar/cal-persia.el 1 Sep 2003 15:45:19 -0000 1.8
--- lisp/calendar/cal-persia.el 18 Sep 2004 20:12:50 -0000
***************
*** 180,186 ****
(let* ((today (calendar-current-date))
(year (calendar-read
"Persian calendar year (not 0): "
! '(lambda (x) (/= x 0))
(int-to-string
(extract-calendar-year
(calendar-persian-from-absolute
--- 180,186 ----
(let* ((today (calendar-current-date))
(year (calendar-read
"Persian calendar year (not 0): "
! (lambda (x) (/= x 0))
(int-to-string
(extract-calendar-year
(calendar-persian-from-absolute
***************
*** 197,203 ****
(last (persian-calendar-last-day-of-month month year))
(day (calendar-read
(format "Persian calendar day (1-%d): " last)
! '(lambda (x) (and (< 0 x) (<= x last))))))
(list (list month day year))))
(defun diary-persian-date ()
--- 197,203 ----
(last (persian-calendar-last-day-of-month month year))
(day (calendar-read
(format "Persian calendar day (1-%d): " last)
! (lambda (x) (and (< 0 x) (<= x last))))))
(list (list month day year))))
(defun diary-persian-date ()
Index: lisp/calendar/cal-tex.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/cal-tex.el,v
retrieving revision 1.25
diff -c -r1.25 cal-tex.el
*** lisp/calendar/cal-tex.el 1 Sep 2003 15:45:19 -0000 1.25
--- lisp/calendar/cal-tex.el 18 Sep 2004 20:12:53 -0000
***************
*** 124,130 ****
You can use this to do postprocessing on the buffer. For example, to change
characters with diacritical marks to their LaTeX equivalents, use
(add-hook 'cal-tex-hook
! '(lambda () (iso-iso2tex (point-min) (point-max))))"
:type 'hook
:group 'calendar-tex)
--- 124,130 ----
You can use this to do postprocessing on the buffer. For example, to change
characters with diacritical marks to their LaTeX equivalents, use
(add-hook 'cal-tex-hook
! (lambda () (iso-iso2tex (point-min) (point-max))))"
:type 'hook
:group 'calendar-tex)
***************
*** 1504,1510 ****
FINAL-SEPARATOR is t."
(let* ((sep (if separator separator "\\\\"))
(result
! (mapconcat '(lambda (x) (cal-tex-LaTeXify-string x))
(let ((result)
(p date-list))
(while p
--- 1504,1510 ----
FINAL-SEPARATOR is t."
(let* ((sep (if separator separator "\\\\"))
(result
! (mapconcat (lambda (x) (cal-tex-LaTeXify-string x))
(let ((result)
(p date-list))
(while p
Index: lisp/calendar/calendar.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/calendar.el,v
retrieving revision 1.157
diff -c -r1.157 calendar.el
*** lisp/calendar/calendar.el 8 May 2004 12:42:07 -0000 1.157
--- lisp/calendar/calendar.el 18 Sep 2004 20:13:04 -0000
***************
*** 1738,1743 ****
--- 1738,1747 ----
"Move cursor to ISO date."
t)
+ (autoload 'calendar-goto-iso-week "cal-iso"
+ "Move cursor to start of ISO WEEK in YEAR."
+ t)
+
(autoload 'calendar-print-iso-date "cal-iso"
"Show the ISO date equivalents of date."
t)
***************
*** 2173,2178 ****
--- 2177,2183 ----
(define-key calendar-mode-map "ge" 'calendar-goto-ethiopic-date)
(define-key calendar-mode-map "gp" 'calendar-goto-persian-date)
(define-key calendar-mode-map "gc" 'calendar-goto-iso-date)
+ (define-key calendar-mode-map "gw" 'calendar-goto-iso-week)
(define-key calendar-mode-map "gf" 'calendar-goto-french-date)
(define-key calendar-mode-map "gml" 'calendar-goto-mayan-long-count-date)
(define-key calendar-mode-map "gmpc" 'calendar-previous-calendar-round-date)
***************
*** 2857,2863 ****
(and (facep mark) mark) ; face-name
diary-entry-marker)))
(if (facep mark)
! (progn ; face or an attr-list that contained a face
(overlay-put
(make-overlay (1- (point)) (1+ (point))) 'face mark))
(if (and (stringp mark)
--- 2862,2868 ----
(and (facep mark) mark) ; face-name
diary-entry-marker)))
(if (facep mark)
! (progn ; face or an attr-list that contained a face
(overlay-put
(make-overlay (1- (point)) (1+ (point))) 'face mark))
(if (and (stringp mark)
***************
*** 2867,2879 ****
(delete-char 1)
(insert mark)
(forward-char -2))
! (let ; attr list
((temp-face
(make-symbol (apply 'concat "temp-face-"
! (mapcar '(lambda (sym)
! (cond ((symbolp sym)
(symbol-name sym))
! ((numberp sym)
(int-to-string sym))
! (t sym))) mark))))
(faceinfo mark))
(make-face temp-face)
;; Remove :face info from the mark, copy the face info into
temp-face
--- 2872,2884 ----
(delete-char 1)
(insert mark)
(forward-char -2))
! (let ; attr list
((temp-face
(make-symbol (apply 'concat "temp-face-"
! (mapcar (lambda (sym)
! (cond ((symbolp sym)
(symbol-name sym))
! ((numberp sym)
(int-to-string sym))
! (t sym))) mark))))
(faceinfo mark))
(make-face temp-face)
;; Remove :face info from the mark, copy the face info into
temp-face