comparison lisp/calendar/cal-bahai.el @ 92578:8b2b620788b7

Unquote lambda functions. Add autoload cookies to functions formerly autoloaded in calendar.el. Set `generated-autoload-file' to "cal-loaddefs.el".

92577:2d599418bddb

;;; cal-bahai.el --- calendar functions for the Bahá'í calendar. -*- coding: utf-8 -*-

;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;;   Free Software Foundation, Inc.

;; Author: John Wiegley <[e-mail]>

           (day	;; Calculate the day by subtraction.
            (- date
               (1- (calendar-absolute-from-bahai (list month 1 year))))))
      (list month day year))))

(defun calendar-bahai-date-string (&optional date)
  "String of Bahá'í date of Gregorian DATE.
Defaults to today's date if DATE is not given."
  (let* ((bahai-date (calendar-bahai-from-absolute
                       (calendar-absolute-from-gregorian

	  (dayname nil)
	  (month (int-to-string m))
	  (year (int-to-string y)))
      (mapconcat 'eval calendar-date-display-form ""))))

(defun calendar-bahai-print-date ()
  "Show the Bahá'í calendar equivalent of the selected date."
  (interactive)
  (message "Bahá'í date: %s"
           (calendar-bahai-date-string (calendar-cursor-to-date t))))

(defun calendar-bahai-goto-date (date &optional noecho)
  "Move cursor to Bahá'í date DATE.
Echo Bahá'í date unless NOECHO is t."
  (interactive (calendar-bahai-prompt-for-date))
  (calendar-goto-date (calendar-gregorian-from-absolute

(defun calendar-bahai-prompt-for-date ()
  "Ask for a Bahá'í date."
  (let* ((today (calendar-current-date))
         (year (calendar-read
                "Bahá'í 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)

                                (append calendar-bahai-month-name-array nil))
                        nil t)
                      (calendar-make-alist calendar-bahai-month-name-array
                                           1))))
         (day (calendar-read "Bahá'í calendar day (1-19): "
			     '(lambda (x) (and (< 0 x) (<= x 19))))))
    (list (list month day year))))

(defun diary-bahai-date ()
  "Bahá'í calendar equivalent of date diary entry."
  (format "Bahá'í date: %s" (calendar-bahai-date-string date)))

                (mark-calendar-days-named
                 (cdr (assoc-string (substring dd-name 0 3)
                                    (calendar-make-alist
                                     calendar-day-name-array
                                     0
                                     '(lambda (x) (substring x 0 3)))
                                    t)))
              (if mm-name
                  (if (string-equal mm-name "*")
                      (setq mm 0)
                    (setq mm

                 (or (zerop year)
                     (= year i-year))
                 (mark-visible-calendar-date
                  (calendar-gregorian-from-absolute date)))))))))

(defun diary-bahai-insert-entry (arg)
  "Insert a diary entry.
For the Bahá'í date corresponding to the date indicated by point.
Prefix arg will make the entry nonmarking."
  (interactive "P")

        (calendar-absolute-from-gregorian
         (calendar-cursor-to-date t)))
       nil t))
     arg)))

(defun diary-bahai-insert-monthly-entry (arg)
  "Insert a monthly diary entry.
For the day of the Bahá'í month corresponding to the date indicated by point.
Prefix arg will make the entry nonmarking."
  (interactive "P")

       (calendar-bahai-from-absolute
        (calendar-absolute-from-gregorian
         (calendar-cursor-to-date t)))))
     arg)))

(defun diary-bahai-insert-yearly-entry (arg)
  "Insert an annual diary entry.
For the day of the Bahá'í year corresponding to the date indicated by point.
Prefix arg will make the entry nonmarking."
  (interactive "P")

(define-obsolete-function-alias
  'calendar-print-bahai-date 'calendar-bahai-print-date "23.1")

(provide 'cal-bahai)

;; arch-tag: c1cb1d67-862a-4264-a01c-41cb4df01f14
;;; cal-bahai.el ends here

92578:8b2b620788b7

;;; cal-bahai.el --- calendar functions for the Bahá'í calendar.

;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;;   Free Software Foundation, Inc.

;; Author: John Wiegley <[e-mail]>

           (day	;; Calculate the day by subtraction.
            (- date
               (1- (calendar-absolute-from-bahai (list month 1 year))))))
      (list month day year))))

;;;###autoload
(defun calendar-bahai-date-string (&optional date)
  "String of Bahá'í date of Gregorian DATE.
Defaults to today's date if DATE is not given."
  (let* ((bahai-date (calendar-bahai-from-absolute
                       (calendar-absolute-from-gregorian

	  (dayname nil)
	  (month (int-to-string m))
	  (year (int-to-string y)))
      (mapconcat 'eval calendar-date-display-form ""))))

;;;###autoload
(defun calendar-bahai-print-date ()
  "Show the Bahá'í calendar equivalent of the selected date."
  (interactive)
  (message "Bahá'í date: %s"
           (calendar-bahai-date-string (calendar-cursor-to-date t))))

;;;###autoload
(defun calendar-bahai-goto-date (date &optional noecho)
  "Move cursor to Bahá'í date DATE.
Echo Bahá'í date unless NOECHO is t."
  (interactive (calendar-bahai-prompt-for-date))
  (calendar-goto-date (calendar-gregorian-from-absolute

(defun calendar-bahai-prompt-for-date ()
  "Ask for a Bahá'í date."
  (let* ((today (calendar-current-date))
         (year (calendar-read
                "Bahá'í 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)

                                (append calendar-bahai-month-name-array nil))
                        nil t)
                      (calendar-make-alist calendar-bahai-month-name-array
                                           1))))
         (day (calendar-read "Bahá'í calendar day (1-19): "
			     (lambda (x) (and (< 0 x) (<= x 19))))))
    (list (list month day year))))

(defun diary-bahai-date ()
  "Bahá'í calendar equivalent of date diary entry."
  (format "Bahá'í date: %s" (calendar-bahai-date-string date)))

                (mark-calendar-days-named
                 (cdr (assoc-string (substring dd-name 0 3)
                                    (calendar-make-alist
                                     calendar-day-name-array
                                     0
                                     (lambda (x) (substring x 0 3)))
                                    t)))
              (if mm-name
                  (if (string-equal mm-name "*")
                      (setq mm 0)
                    (setq mm

                 (or (zerop year)
                     (= year i-year))
                 (mark-visible-calendar-date
                  (calendar-gregorian-from-absolute date)))))))))

;;;###autoload
(defun diary-bahai-insert-entry (arg)
  "Insert a diary entry.
For the Bahá'í date corresponding to the date indicated by point.
Prefix arg will make the entry nonmarking."
  (interactive "P")

        (calendar-absolute-from-gregorian
         (calendar-cursor-to-date t)))
       nil t))
     arg)))

;;;###autoload
(defun diary-bahai-insert-monthly-entry (arg)
  "Insert a monthly diary entry.
For the day of the Bahá'í month corresponding to the date indicated by point.
Prefix arg will make the entry nonmarking."
  (interactive "P")

       (calendar-bahai-from-absolute
        (calendar-absolute-from-gregorian
         (calendar-cursor-to-date t)))))
     arg)))

;;;###autoload
(defun diary-bahai-insert-yearly-entry (arg)
  "Insert an annual diary entry.
For the day of the Bahá'í year corresponding to the date indicated by point.
Prefix arg will make the entry nonmarking."
  (interactive "P")

(define-obsolete-function-alias
  'calendar-print-bahai-date 'calendar-bahai-print-date "23.1")

(provide 'cal-bahai)

;; Local Variables:
;; coding: utf-8
;; generated-autoload-file: "cal-loaddefs.el"
;; End:

;; arch-tag: c1cb1d67-862a-4264-a01c-41cb4df01f14
;;; cal-bahai.el ends here