;;; calendar.el --- calendar functions
-;; Copyright (C) 1988-1995, 1997, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1988-1995, 1997, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; can be translated from the (usual) Gregorian calendar to the day of
;; the year/days remaining in year, to the ISO commercial calendar, to
;; the Julian (old style) calendar, to the Hebrew calendar, to the
-;; Islamic calendar, to the Bahá'í calendar, to the French
+;; Islamic calendar, to the Bahá’í calendar, to the French
;; Revolutionary calendar, to the Mayan calendar, to the Chinese
;; calendar, to the Coptic calendar, to the Ethiopic calendar, and to
;; the astronomical (Julian) day number. Times of sunrise/sunset can
;; The following files are part of the calendar/diary code:
;; appt.el Appointment notification
-;; cal-bahai.el Bahá'í calendar
+;; cal-bahai.el Bahá’í calendar
;; cal-china.el Chinese calendar
;; cal-coptic.el Coptic/Ethiopic calendars
;; cal-dst.el Daylight saving time rules
(calendar-redraw))
:group 'calendar)
-(define-obsolete-variable-alias 'view-diary-entries-initially
- 'calendar-view-diary-initially-flag "23.1")
+(defcustom calendar-weekend-days '(0 6)
+ "Days of the week considered weekend days.
+0 means Sunday, 1 means Monday, and so on.
+
+Determines which day headers are fontified with
+`calendar-weekend-header'."
+ :type '(repeat integer)
+ :version "25.1"
+ :group 'calendar)
(defcustom calendar-view-diary-initially-flag nil
"Non-nil means display current date's diary entries on entry to calendar.
:type 'boolean
:group 'diary)
-(define-obsolete-variable-alias 'mark-diary-entries-in-calendar
- 'calendar-mark-diary-entries-flag "23.1")
-
;; FIXME :set
(defcustom calendar-mark-diary-entries-flag nil
"Non-nil means mark dates with diary entries, in the calendar window.
See the variable `calendar-today-marker'."
:group 'calendar-faces)
-(define-obsolete-face-alias 'calendar-today-face 'calendar-today "22.1")
-
(defface diary
'((((min-colors 88) (class color) (background light))
:foreground "red1")
and to highlight the date header in the fancy diary."
:group 'calendar-faces)
-(define-obsolete-face-alias 'diary-face 'diary "22.1")
-
(defface holiday
'((((class color) (background light))
:background "pink")
See `calendar-holiday-marker'."
:group 'calendar-faces)
-(define-obsolete-face-alias 'holiday-face 'holiday "22.1")
+(defface calendar-weekday-header '((t :inherit font-lock-constant-face))
+ "Face used for weekday column headers in the calendar.
+See also the face `calendar-weekend-header'."
+ :version "24.4"
+ :group 'calendar-faces)
+
+(defface calendar-weekend-header '((t :inherit font-lock-comment-face))
+ "Face used for weekend column headers in the calendar.
+See also the face `calendar-weekday-header'."
+ :version "24.4"
+ :group 'calendar-faces)
+
+(defface calendar-month-header '((t :inherit font-lock-function-name-face))
+ "Face used for month headers in the calendar."
+ :version "24.4"
+ :group 'calendar-faces)
;; These briefly checked font-lock-mode, but that is broken, since it
;; is a buffer-local variable, and which buffer happens to be current
:group 'holidays
:version "23.1")
-(define-obsolete-variable-alias 'view-calendar-holidays-initially
- 'calendar-view-holidays-initially-flag "23.1")
-
(defcustom calendar-view-holidays-initially-flag nil
"Non-nil means display holidays for current three month period on entry.
The holidays are displayed in another window when the calendar is first
:type 'boolean
:group 'holidays)
-(define-obsolete-variable-alias 'mark-holidays-in-calendar
- 'calendar-mark-holidays-flag "23.1")
-
;; FIXME :set
(defcustom calendar-mark-holidays-flag nil
"Non-nil means mark dates of holidays in the calendar window.
:type 'hook
:group 'calendar-hooks)
-(define-obsolete-variable-alias 'initial-calendar-window-hook
- 'calendar-initial-window-hook "23.1")
-
(defcustom calendar-initial-window-hook nil
"List of functions to be called when the calendar window is created.
Quitting the calendar and re-entering it will cause these functions
:type 'hook
:group 'calendar-hooks)
-(define-obsolete-variable-alias 'today-visible-calendar-hook
- 'calendar-today-visible-hook "23.1")
-
(defcustom calendar-today-visible-hook nil
"List of functions called whenever the current date is visible.
To mark today's date, add the function `calendar-mark-today'.
:options '(calendar-mark-today calendar-star-date)
:group 'calendar-hooks)
-(define-obsolete-variable-alias 'today-invisible-calendar-hook
- 'calendar-today-invisible-hook "23.1")
-
(defcustom calendar-today-invisible-hook nil
"List of functions called whenever the current date is not visible.
See also `calendar-today-visible-hook'."
"List of functions called whenever the cursor moves in the calendar.
For example,
- (add-hook 'calendar-move-hook (lambda () (diary-view-entries 1)))
+ (add-hook \\='calendar-move-hook (lambda () (diary-view-entries 1)))
redisplays the diary for whatever date the cursor is moved to."
:type 'hook
integers appropriate to the relevant date. For example, to
display the ISO date:
- (setq calendar-date-echo-text '(format \"ISO date: %s\"
+ (setq calendar-date-echo-text \\='(format \"ISO date: %s\"
(calendar-iso-date-string
(list month day year))))
Changing this variable without using customize has no effect on
(push (cons i (calendar-month-edges i)) calendar-month-edges))
(setq calendar-month-edges (reverse calendar-month-edges)))
-;; FIXME add font-lock-keywords.
(defun calendar-set-layout-variable (symbol value &optional minmax)
"Set SYMBOL's value to VALUE, an integer.
A positive/negative MINMAX enforces a minimum/maximum value.
:type 'integer
:version "23.1")
+(defun calendar-day-header-construct (&optional width)
+ "Return the default value for `calendar-day-header-array'.
+WIDTH defaults to `calendar-day-header-width'."
+ (or width (setq width calendar-day-header-width))
+ (calendar-abbrev-construct (if (<= width calendar-abbrev-length)
+ calendar-day-abbrev-array
+ calendar-day-name-array)
+ width))
+
+;; FIXME better to use a format spec?
(defcustom calendar-day-header-width 2
"Width of the day column headers in the calendar.
Must be at least one less than `calendar-column-width'."
:group 'calendar
:initialize 'custom-initialize-default
:set (lambda (sym val)
+ (or (calendar-customized-p 'calendar-day-header-array)
+ (setq calendar-day-header-array
+ (calendar-day-header-construct val)))
(calendar-set-layout-variable sym val (- 1 calendar-column-width)))
:type 'integer
:version "23.1")
(setq calendar-week-start-day 1
calendar-intermonth-text
- '(propertize
+ \\='(propertize
(format \"%2d\"
(car
(calendar-iso-from-absolute
(calendar-absolute-from-gregorian (list month day year)))))
- 'font-lock-face 'font-lock-function-name-face))
+ \\='font-lock-face \\='font-lock-function-name-face))
See also `calendar-intermonth-header'."
:group 'calendar
'font-lock-face 'font-lock-function-name-face)))
:version "23.1")
-(defcustom diary-file "~/diary"
+(defcustom diary-file (locate-user-emacs-file "diary" "diary")
"Name of the file in which one's personal diary of dates is kept.
The file's entries are lines beginning with any of the forms
November 10, 1990. See the documentation for the function
`diary-list-sexp-entries' for more details.
-Diary entries based on the Hebrew, the Islamic and/or the Bahá'í
+Diary entries based on the Hebrew, the Islamic and/or the Bahá’í
calendar are also possible, but because these are somewhat slow, they
are ignored unless you set the `diary-nongregorian-listing-hook' and
the `diary-nongregorian-marking-hook' appropriately. See the
Diary files can contain directives to include the contents of other files; for
details, see the documentation for the variable `diary-list-entries-hook'."
+ :version "25.1" ; ~/diary -> locate-user-emacs-file
:type 'file
:group 'diary)
:type 'string
:group 'diary)
-(define-obsolete-variable-alias 'hebrew-diary-entry-symbol
- 'diary-hebrew-entry-symbol "23.1")
+(defcustom diary-chinese-entry-symbol "C"
+ "Symbol indicating a diary entry according to the Chinese calendar."
+ :type 'string
+ :group 'diary
+ :version "25.1")
(defcustom diary-hebrew-entry-symbol "H"
"Symbol indicating a diary entry according to the Hebrew calendar."
:type 'string
:group 'diary)
-(define-obsolete-variable-alias 'islamic-diary-entry-symbol
- 'diary-islamic-entry-symbol "23.1")
-
(defcustom diary-islamic-entry-symbol "I"
"Symbol indicating a diary entry according to the Islamic calendar."
:type 'string
:group 'diary)
-(define-obsolete-variable-alias 'bahai-diary-entry-symbol
- 'diary-bahai-entry-symbol "23.1")
-
(defcustom diary-bahai-entry-symbol "B"
- "Symbol indicating a diary entry according to the Bahá'í calendar."
+ "Symbol indicating a diary entry according to the Bahá’í calendar."
:type 'string
:group 'diary)
-(defcustom european-calendar-style nil
- "Non-nil means use the European style of dates in the diary and display.
-In this case, a date like 1/2/1990 would be interpreted as
-February 1, 1990. See `diary-european-date-forms' for the
-default European diary date styles.
-
-Setting this variable directly does not take effect (if the
-calendar package is already loaded). Rather, use either
-\\[customize] or the function `calendar-set-date-style'."
- :type 'boolean
- ;; Without :initialize (require 'calendar) throws an error because
- ;; calendar-set-date-style is undefined at this point.
- :initialize 'custom-initialize-default
- :set (lambda (symbol value)
- (if value
- (calendar-set-date-style 'european)
- (calendar-set-date-style 'american)))
- :group 'calendar)
-
-(make-obsolete-variable 'european-calendar-style 'calendar-date-style "23.1")
-
-;; If this is autoloaded, c-d-s gets set before any customization of e-c-s.
-(defcustom calendar-date-style (if european-calendar-style 'european
- 'american)
+(defcustom calendar-date-style 'american
"Your preferred style for writing dates.
The options are:
`american' - month/day/year
(choice symbol regexp)))))
:group 'diary)
-(define-obsolete-variable-alias 'american-date-diary-pattern
- 'diary-american-date-forms "23.1")
-
(defcustom diary-american-date-forms
'((month "/" day "[^/0-9]")
(month "/" day "/" year "[^0-9]")
(choice symbol regexp)))))
:group 'diary)
-(define-obsolete-variable-alias 'european-date-diary-pattern
- 'diary-european-date-forms "23.1")
-
(defcustom diary-european-date-forms
'((day "/" month "[^/0-9]")
(day "/" month "/" year "[^0-9]")
:version "23.1"
:group 'calendar)
-(define-obsolete-variable-alias 'european-calendar-display-form
- 'calendar-european-date-display-form "23.1")
-
(defcustom calendar-european-date-display-form
'((if dayname (concat dayname ", ")) day " " monthname " " year)
"Pseudo-pattern governing the way a date appears in the European style.
:type 'sexp
:group 'calendar)
-(define-obsolete-variable-alias 'american-calendar-display-form
- 'calendar-american-date-display-form "23.1")
-
(defcustom calendar-american-date-display-form
'((if dayname (concat dayname ", ")) monthname " " day ", " year)
"Pseudo-pattern governing the way a date appears in the American style.
and `year' (all numbers in string form), and `monthname' and `dayname'
\(both alphabetic strings). For example, a typical American form would be
- '(month \"/\" day \"/\" (substring year -2))
+ (month \"/\" day \"/\" (substring year -2))
whereas
- '((format \"%9s, %9s %2s, %4s\" dayname monthname day year))
+ ((format \"%9s, %9s %2s, %4s\" dayname monthname day year))
would give the usual American style in fixed-length fields. The variables
`calendar-iso-date-display-form', `calendar-european-date-display-form', and
(defcustom calendar-american-month-header
'(propertize (format "%s %d" (calendar-month-name month) year)
- 'font-lock-face 'font-lock-function-name-face)
+ 'font-lock-face 'calendar-month-header)
"Default format for calendar month headings with the American date style.
Normally you should not customize this, but `calender-month-header'."
:group 'calendar
:risky t
:type 'sexp
- :version "24.3")
+ :version "24.4") ; font-lock-function-name-face -> calendar-month-header
(defcustom calendar-european-month-header
'(propertize (format "%s %d" (calendar-month-name month) year)
- 'font-lock-face 'font-lock-function-name-face)
+ 'font-lock-face 'calendar-month-header)
"Default format for calendar month headings with the European date style.
Normally you should not customize this, but `calender-month-header'."
:group 'calendar
:risky t
:type 'sexp
- :version "24.3")
+ :version "24.4") ; font-lock-function-name-face -> calendar-month-header
(defcustom calendar-iso-month-header
'(propertize (format "%d %s" year (calendar-month-name month))
- 'font-lock-face 'font-lock-function-name-face)
+ 'font-lock-face 'calendar-month-header)
"Default format for calendar month headings with the ISO date style.
Normally you should not customize this, but `calender-month-header'."
:group 'calendar
:risky t
:type 'sexp
- :version "24.3")
+ :version "24.4") ; font-lock-function-name-face -> calendar-month-header
(defcustom calendar-month-header
(cond ((eq calendar-date-style 'iso)
(calendar-redraw)
(calendar-update-mode-line))
-(defun european-calendar ()
- "Set the interpretation and display of dates to the European style."
- (declare (obsolete calendar-set-date-style "23.1"))
- (interactive)
- (calendar-set-date-style 'european))
-
-(defun american-calendar ()
- "Set the interpretation and display of dates to the American style."
- (declare (obsolete calendar-set-date-style "23.1"))
- (interactive)
- (calendar-set-date-style 'american))
-
-(define-obsolete-variable-alias 'holidays-in-diary-buffer
- 'diary-show-holidays-flag "23.1")
-
(defcustom diary-show-holidays-flag t
"Non-nil means include holidays in the diary display.
The holidays appear in the mode line of the diary buffer, or in the
:type 'boolean
:group 'calendar)
-(define-obsolete-variable-alias 'all-hebrew-calendar-holidays
- 'calendar-hebrew-all-holidays-flag "23.1")
-
(defcustom calendar-hebrew-all-holidays-flag nil
"If nil, show only major holidays from the Hebrew calendar.
This means only those Jewish holidays that appear on secular calendars.
:type 'boolean
:group 'holidays)
-(define-obsolete-variable-alias 'all-christian-calendar-holidays
- 'calendar-christian-all-holidays-flag "23.1")
-
(defcustom calendar-christian-all-holidays-flag nil
"If nil, show only major holidays from the Christian calendar.
This means only those Christian holidays that appear on secular calendars.
:type 'boolean
:group 'holidays)
-(define-obsolete-variable-alias 'all-islamic-calendar-holidays
- 'calendar-islamic-all-holidays-flag "23.1")
-
(defcustom calendar-islamic-all-holidays-flag nil
"If nil, show only major holidays from the Islamic calendar.
This means only those Islamic holidays that appear on secular calendars.
:type 'boolean
:group 'holidays)
-(define-obsolete-variable-alias 'all-bahai-calendar-holidays
- 'calendar-bahai-all-holidays-flag "23.1")
-
(defcustom calendar-bahai-all-holidays-flag nil
- "If nil, show only major holidays from the Bahá'í calendar.
+ "If nil, show only major holidays from the Bahá’í calendar.
These are the days on which work and school must be suspended.
-Otherwise, show all the holidays that would appear in a complete Bahá'í
+Otherwise, show all the holidays that would appear in a complete Bahá’í
calendar."
:type 'boolean
:group 'holidays)
(defconst diary-fancy-buffer "*Fancy Diary Entries*"
"Name of the buffer used for the optional fancy display of the diary.")
-(define-obsolete-variable-alias 'fancy-diary-buffer 'diary-fancy-buffer "23.1")
-
(defconst calendar-other-calendars-buffer "*Other Calendars*"
"Name of the buffer used for the display of date on other calendars.")
(and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
(if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc
-(define-obsolete-function-alias 'increment-calendar-month
- 'calendar-increment-month "23.1")
-
(defvar displayed-month)
(defvar displayed-year)
(calendar-increment-month mon yr n)
(cons mon yr))
-(defmacro calendar-for-loop (var from init to final do &rest body)
- "Execute a for loop.
-Evaluate BODY with VAR bound to successive integers from INIT to FINAL,
-inclusive. The standard macro `dotimes' is preferable in most cases."
- (declare (obsolete "use `dotimes' or `while' instead." "23.1")
- (debug (symbolp "from" form "to" form "do" body))
- (indent defun))
- `(let ((,var (1- ,init)))
- (while (>= ,final (setq ,var (1+ ,var)))
- ,@body)))
-
(defmacro calendar-sum (index initial condition expression)
"For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION."
(declare (debug (symbolp form form form)))
(setq buffer-read-only nil
buffer-undo-list t)
(erase-buffer)
+ (display-buffer ,buffer)
,@body
(goto-char (point-min))
(set-buffer-modified-p nil)
- (setq buffer-read-only t)
- (display-buffer ,buffer)))
+ (setq buffer-read-only t)))
;; The following are in-line for speed; they can be called thousands of times
;; when looking up holidays or processing the diary. Here, for example, are
"Extract the month part of DATE which has the form (month day year)."
(car date))
-(define-obsolete-function-alias 'extract-calendar-month
- 'calendar-extract-month "23.1")
-
;; Note gives wrong answer for result of (calendar-read-date 'noday),
;; but that is only used by `calendar-other-month'.
(defsubst calendar-extract-day (date)
"Extract the day part of DATE which has the form (month day year)."
(cadr date))
-(define-obsolete-function-alias 'extract-calendar-day
- 'calendar-extract-day "23.1")
-
(defsubst calendar-extract-year (date)
"Extract the year part of DATE which has the form (month day year)."
(nth 2 date))
-(define-obsolete-function-alias 'extract-calendar-year
- 'calendar-extract-year "23.1")
-
(defsubst calendar-leap-year-p (year)
"Return t if YEAR is a Gregorian leap year.
A negative year is interpreted as BC; -1 being 1 BC, and so on."
(defsubst calendar-day-number (date)
"Return the day number within the year of the date DATE.
-For example, (calendar-day-number '(1 1 1987)) returns the value 1,
-while (calendar-day-number '(12 31 1980)) returns 366."
+For example, (calendar-day-number \\='(1 1 1987)) returns the value 1,
+while (calendar-day-number \\='(12 31 1980)) returns 366."
(let* ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date))
(let ((year (calendar-extract-year date))
offset-years)
(cond ((zerop year)
- (error "There was no year zero"))
+ (user-error "There was no year zero"))
((> year 0)
(setq offset-years (1- year))
(+ (calendar-day-number date) ; days this year
;; the right thing in that case.
;;
;; Is this a wide frame? If so, split it horizontally.
- (if (window-splittable-p t) (split-window-right))
+
+ ;; The following doesn't sound useful: If we split horizontally
+ ;; here, the subsequent `pop-to-buffer' will likely split again
+ ;; horizontally and we end up with three side-by-side windows.
+ (when (window-splittable-p (selected-window) t)
+ (split-window-right))
(pop-to-buffer calendar-buffer)
;; Has the window already been split vertically?
(when (and (not (window-dedicated-p))
+ (window-splittable-p (selected-window))
(window-full-height-p))
(let ((win (split-window-below)))
;; In the upper window, show whatever was visible before.
(calendar-generate-window month year)
(if (and calendar-view-diary-initially-flag
(calendar-date-is-visible-p date))
- (diary-view-entries))))
+ ;; Do not clobber the calendar with the diary, if the diary
+ ;; has previously been shown in the window that now shows the
+ ;; calendar (bug#18381).
+ (let ((display-buffer-overriding-action
+ '(nil . ((inhibit-same-window . t)))))
+ (diary-view-entries)))))
(if calendar-view-holidays-initially-flag
- (let* ((diary-buffer (get-file-buffer diary-file))
+ (let* ((diary-buffer (diary-live-p))
(diary-window (if diary-buffer (get-buffer-window diary-buffer)))
(split-height-threshold (if diary-window 2 1000)))
;; FIXME display buffer?
(year (calendar-extract-year today))
(today-visible (or (not mon)
(<= (abs (calendar-interval mon yr month year)) 1)))
- (in-calendar-window (eq (window-buffer (selected-window))
+ (in-calendar-window (eq (window-buffer)
(get-buffer calendar-buffer))))
(calendar-generate (or mon month) (or yr year))
(calendar-update-mode-line)
;; combined don't fit height to that of its buffer.
(set-window-vscroll nil 0))
(sit-for 0))
- (and (bound-and-true-p font-lock-mode)
- (font-lock-fontify-buffer))
(and calendar-mark-holidays-flag
-;;; (calendar-date-is-valid-p today) ; useful for BC dates
+ ;; (calendar-date-is-valid-p today) ; useful for BC dates
(calendar-mark-holidays)
(and in-calendar-window (sit-for 0)))
(unwind-protect
(if calendar-mark-diary-entries-flag (diary-mark-entries))
- (if today-visible
- (run-hooks 'calendar-today-visible-hook)
- (run-hooks 'calendar-today-invisible-hook)))))
+ (run-hooks (if today-visible
+ 'calendar-today-visible-hook
+ 'calendar-today-invisible-hook)))))
(defun calendar-generate (month year)
"Generate a three-month Gregorian calendar centered around MONTH, YEAR."
;; stands, almost all other calendar functions (eg holidays) would
;; at best have unpredictable results for such dates.
(if (< (+ month (* 12 (1- year))) 2)
- (error "Months before January, 1 AD cannot be displayed"))
+ (user-error "Months before January, 1 AD cannot be displayed"))
(setq displayed-month month
displayed-year year)
(erase-buffer)
(trunc (min calendar-intermonth-spacing
(1- calendar-left-margin)))
(day 1)
- string)
+ j)
(goto-char (point-min))
(calendar-move-to-column indent)
(insert
?\s calendar-month-digit-width))
(calendar-ensure-newline)
(calendar-insert-at-column indent calendar-intermonth-header trunc)
- ;; Use the first two characters of each day to head the columns.
+ ;; Use the first N characters of each day to head the columns.
(dotimes (i 7)
+ (setq j (mod (+ calendar-week-start-day i) 7))
(insert
- (progn
- (setq string
- (calendar-day-name (mod (+ calendar-week-start-day i) 7) nil t))
- (if enable-multibyte-characters
- (truncate-string-to-width string calendar-day-header-width)
- (substring string 0 calendar-day-header-width)))
+ (truncate-string-to-width
+ (propertize (calendar-day-name j 'header t)
+ 'font-lock-face (if (memq j calendar-weekend-days)
+ 'calendar-weekend-header
+ 'calendar-weekday-header))
+ calendar-day-header-width nil ?\s)
(make-string (- calendar-column-width calendar-day-header-width) ?\s)))
(calendar-ensure-newline)
(calendar-insert-at-column indent calendar-intermonth-text trunc)
(dotimes (i last)
(setq day (1+ i))
;; TODO should numbers be left-justified, centered...?
- (insert (format (format "%%%dd%%s" calendar-day-digit-width) day
- (make-string
- (- calendar-column-width calendar-day-digit-width) ?\s)))
- ;; 'date property prevents intermonth text confusing re-searches.
- ;; (Tried intangible, it did not really work.)
- (set-text-properties
- (- (point) (1+ calendar-day-digit-width)) (1- (point))
- `(mouse-face highlight help-echo ,(eval calendar-date-echo-text)
- date t))
+ (insert (propertize
+ (format (format "%%%dd" calendar-day-digit-width) day)
+ 'mouse-face 'highlight
+ 'help-echo (eval calendar-date-echo-text)
+ ;; 'date property prevents intermonth text confusing re-searches.
+ ;; (Tried intangible, it did not really work.)
+ 'date t)
+ (make-string
+ (- calendar-column-width calendar-day-digit-width) ?\s))
(when (and (zerop (mod (+ day blank-days) 7))
(/= day last))
(calendar-ensure-newline)
(define-key map "iBd" 'diary-bahai-insert-entry)
(define-key map "iBm" 'diary-bahai-insert-monthly-entry)
(define-key map "iBy" 'diary-bahai-insert-yearly-entry)
+ (define-key map "iCd" 'diary-chinese-insert-entry)
+ (define-key map "iCm" 'diary-chinese-insert-monthly-entry)
+ (define-key map "iCy" 'diary-chinese-insert-yearly-entry)
+ (define-key map "iCa" 'diary-chinese-insert-anniversary-entry)
(define-key map "?" 'calendar-goto-info-node)
(define-key map "Hm" 'cal-html-cursor-month)
(define-key map "Hy" 'cal-html-cursor-year)
nil "today"))
'(calendar-date-string (calendar-current-date) t)
(calendar-mode-line-entry 'calendar-scroll-left "next month" ">"))
- "The mode line of the calendar buffer.
+ "If non-nil, the mode line of the calendar buffer.
This is a list of items that evaluate to strings. The elements
are evaluated and concatenated, evenly separated by blanks.
During evaluation, the variable `date' is available as the date
nearest the cursor (or today's date if that fails). To update
-the mode-line as the cursor moves, add `calendar-update-mode-line'
-to `calendar-move-hook'. Here is an example that has the Hebrew date,
-the day number/days remaining in the year, and the ISO week/year numbers:
+the mode-line as the cursor moves, add
+`calendar-update-mode-line' to `calendar-move-hook'.
+
+If nil, do not modify the mode line at all.
+
+Here is an example that has the Hebrew date, the day number/days
+remaining in the year, and the ISO week/year numbers:
(list
\"\"
- '(calendar-hebrew-date-string date)
- '(let* ((year (calendar-extract-year date))
+ \\='(calendar-hebrew-date-string date)
+ \\='(let* ((year (calendar-extract-year date))
(d (calendar-day-number date))
(days-remaining
(- (calendar-day-number (list 12 31 year)) d)))
(format \"%d/%d\" d days-remaining))
- '(let* ((d (calendar-absolute-from-gregorian date))
+ \\='(let* ((d (calendar-absolute-from-gregorian date))
(iso-date (calendar-iso-from-absolute d)))
(format \"ISO week %d of %d\"
(calendar-extract-month iso-date)
;; soon in calendar-generate, but better safe than sorry.
(unless (boundp 'displayed-month) (setq displayed-month 1))
(unless (boundp 'displayed-year) (setq displayed-year 2001))
- (set (make-local-variable 'font-lock-defaults)
- '(calendar-font-lock-keywords t)))
+ (if (bound-and-true-p calendar-font-lock-keywords)
+ (set (make-local-variable 'font-lock-defaults)
+ '(calendar-font-lock-keywords t))))
(defun calendar-string-spread (strings char length)
"Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH.
(defun calendar-update-mode-line ()
"Update the calendar mode line with the current date and date style."
- (if (bufferp (get-buffer calendar-buffer))
+ (if (and calendar-mode-line-format
+ (bufferp (get-buffer calendar-buffer)))
(with-current-buffer calendar-buffer
(let ((start (- calendar-left-margin 2))
(date (condition-case nil
(dolist (b calendar-buffers)
(quit-windows-on b kill))))))
-(define-obsolete-function-alias 'exit-calendar 'calendar-exit "23.1")
-
(defun calendar-current-date (&optional offset)
"Return the current date in a list (month day year).
Optional integer OFFSET is a number of days from the current date."
(and standard
(not (equal (eval (car standard)) (default-value symbol)))))))
-(defun calendar-abbrev-construct (full)
+(defun calendar-abbrev-construct (full &optional maxlen)
"From sequence FULL, return a vector of abbreviations.
-Each abbreviation is no longer than `calendar-abbrev-length' characters."
+Each abbreviation is no longer than MAXLEN (default `calendar-abbrev-length')
+characters."
+ (or maxlen (setq maxlen calendar-abbrev-length))
(apply 'vector (mapcar
(lambda (f)
- (substring f 0 (min calendar-abbrev-length (length f))))
+ ;; TODO? truncate-string-to-width?
+ (substring f 0 (min maxlen (length f))))
full)))
(defcustom calendar-day-name-array
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]
"Array of capitalized strings giving, in order from Sunday, the day names.
-The first two characters of each string will be used to head the
-day columns in the calendar.
If you change this without using customize after the calendar has loaded,
-then you may also want to change `calendar-day-abbrev-array'."
+then you may also want to change `calendar-day-abbrev-array'
+and `calendar-day-header-array'."
:group 'calendar
:initialize 'custom-initialize-default
:set (lambda (symbol value)
(let ((dcustomized (calendar-customized-p 'calendar-day-abbrev-array))
- (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array)))
+ (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array))
+ (ccustomized (calendar-customized-p 'calendar-day-header-array)))
(set symbol value)
(or dcustomized
(setq calendar-day-abbrev-array
(calendar-abbrev-construct calendar-day-name-array)))
(and (not hcustomized)
(boundp 'cal-html-day-abbrev-array)
- (setq cal-html-day-abbrev-array calendar-day-abbrev-array))))
+ (setq cal-html-day-abbrev-array calendar-day-abbrev-array))
+ (or ccustomized
+ (equal calendar-day-header-array
+ (setq calendar-day-header-array
+ (calendar-day-header-construct)))
+ (calendar-redraw))))
:type '(vector (string :tag "Sunday")
(string :tag "Monday")
(string :tag "Tuesday")
(let ((dcustomized (calendar-customized-p 'calendar-day-abbrev-array))
(mcustomized (calendar-customized-p
'calendar-month-abbrev-array))
- (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array)))
+ (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array))
+ (ccustomized (calendar-customized-p 'calendar-day-header-array)))
(set symbol value)
(or dcustomized
(setq calendar-day-abbrev-array
(calendar-abbrev-construct calendar-month-name-array)))
(and (not hcustomized)
(boundp 'cal-html-day-abbrev-array)
- (setq cal-html-day-abbrev-array calendar-day-abbrev-array))))
+ (setq cal-html-day-abbrev-array calendar-day-abbrev-array))
+ (or ccustomized
+ (equal calendar-day-header-array
+ (setq calendar-day-header-array
+ (calendar-day-header-construct)))
+ (calendar-redraw))))
:type 'integer)
(defcustom calendar-day-abbrev-array
:initialize 'custom-initialize-default
:set-after '(calendar-abbrev-length calendar-day-name-array)
:set (lambda (symbol value)
- (let ((hcustomized (calendar-customized-p 'cal-html-day-abbrev-array)))
+ (let ((hcustomized (calendar-customized-p 'cal-html-day-abbrev-array))
+ (ccustomized (calendar-customized-p 'calendar-day-header-array)))
(set symbol value)
(and (not hcustomized)
(boundp 'cal-html-day-abbrev-array)
- (setq cal-html-day-abbrev-array calendar-day-abbrev-array))))
+ (setq cal-html-day-abbrev-array calendar-day-abbrev-array))
+ (or ccustomized
+ (equal calendar-day-header-array
+ (setq calendar-day-header-array
+ (calendar-day-header-construct)))
+ (calendar-redraw))))
:type '(vector (string :tag "Sun")
(string :tag "Mon")
(string :tag "Tue")
;; Made defcustom, changed defaults from nil nil...
:version "24.1")
+(defcustom calendar-day-header-array (calendar-day-header-construct)
+ "Array of strings to use for the headers of the calendar's day columns.
+The order should be the same as in `calendar-day-name-array'.
+In use, the calendar truncates elements to no more than
+`calendar-day-header-width' columns wide.
+Emacs constructs the default from either `calendar-day-name-array'
+\(if `calendar-day-header-width' is more than `calendar-abbrev-length'),
+or from `calendar-day-abbrev-array' (assuming that the abbreviated
+name are more likely to be unique when truncated)."
+ :group 'calendar
+ :initialize 'custom-initialize-default
+ :set-after '(calendar-day-header-width
+ calendar-abbrev-length calendar-day-name-array
+ calendar-day-abbrev-array)
+ :set (lambda (symbol value)
+ (or (equal calendar-day-header-array
+ (set symbol value))
+ (calendar-redraw)))
+ :type '(vector (string :tag "Su")
+ (string :tag "Mo")
+ (string :tag "Tu")
+ (string :tag "We")
+ (string :tag "Th")
+ (string :tag "Fr")
+ (string :tag "Sa"))
+ :version "24.4")
+
(defcustom calendar-month-name-array
["January" "February" "March" "April" "May" "June"
"July" "August" "September" "October" "November" "December"]
the calendar menu entries, and can also be used in the diary
file. Do not include a trailing `.' in the strings specified in
this variable, though you may use such in the diary file. By
-default, each string is the first ``calendar-abbrev-length'
+default, each string is the first `calendar-abbrev-length'
characters of the corresponding full name."
:group 'calendar
:set-after '(calendar-abbrev-length calendar-month-name-array)
(+ (* 12 (- yr2 yr1))
(- mon2 mon1)))
-(defvar calendar-font-lock-keywords
- ;; Month and year. Not really needed now that calendar-month-header
- ;; contains propertize, and not correct for non-american forms
- ;; of that variable.
- `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
- " -?[0-9]+")
- . font-lock-function-name-face)
- (,(regexp-opt
- (list (substring (aref calendar-day-name-array 6)
- 0 calendar-day-header-width)
- (substring (aref calendar-day-name-array 0)
- 0 calendar-day-header-width)))
- ;; Saturdays and Sundays are highlighted differently.
- . font-lock-comment-face)
- ;; First two chars of each day are used in the calendar.
- (,(regexp-opt (mapcar (lambda (x) (substring x 0 calendar-day-header-width))
- calendar-day-name-array))
- . font-lock-constant-face))
+(defvar calendar-font-lock-keywords nil
"Default keywords to highlight in Calendar mode.")
+(make-obsolete-variable 'calendar-font-lock-keywords
+ "set font-lock keywords in `calendar-mode-hook', \
+or customize calendar faces." "24.4")
+
(defun calendar-day-name (date &optional abbrev absolute)
"Return a string with the name of the day of the week of DATE.
DATE should be a list in the format (MONTH DAY YEAR), unless the
optional argument ABSOLUTE is non-nil, in which case DATE should
be an integer in the range 0 to 6 corresponding to the day of the
week. Day names are taken from the variable `calendar-day-name-array',
-unless the optional argument ABBREV is non-nil, in which case
-the variable `calendar-day-abbrev-array' is used."
- (aref (if abbrev calendar-day-abbrev-array calendar-day-name-array)
+unless the optional argument ABBREV is non-nil:
+`header' means to use `calendar-day-header-array';
+t to use `calendar-day-abbrev-array'."
+ (aref (cond ((eq abbrev 'header) calendar-day-header-array)
+ (abbrev calendar-day-abbrev-array)
+ (t calendar-day-name-array))
(if absolute date (calendar-day-of-week date))))
(defun calendar-month-name (month &optional abbrev)
;; Note there are side effects on calendar navigation.
(<= 1 year))))
-(define-obsolete-function-alias 'calendar-date-is-legal-p
- 'calendar-date-is-valid-p "23.1")
-
(defun calendar-date-equal (date1 date2)
"Return t if the DATE1 and DATE2 are the same."
(and
(make-overlay (1- (point)) (1+ (point))) 'face
(calendar-make-temp-face mark))))))))
-(define-obsolete-function-alias 'mark-visible-calendar-date
- 'calendar-mark-visible-date "23.1")
-
(defun calendar-star-date ()
"Replace the date under the cursor in the calendar window with asterisks.
You might want to add this function to `calendar-today-visible-hook'."
(unless (string-equal
(setq odate (calendar-bahai-date-string date))
"")
- (format "Bahá'í date: %s" odate))
+ (format "Bahá’í date: %s" odate))
(format "Chinese date: %s"
(calendar-chinese-date-string date))
(unless (string-equal
"---")
(calendar-string-spread (list str) ?- width)))))
-(define-obsolete-function-alias 'calendar-version 'emacs-version "23.1")
-
(run-hooks 'calendar-load-hook)
(provide 'calendar)
;; Local variables:
;; byte-compile-dynamic: t
-;; coding: utf-8
;; End:
;;; calendar.el ends here