;;; calendar.el --- calendar functions
-;; Copyright (C) 1988-1995, 1997, 2000-2013 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1988-1995, 1997, 2000-2014 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
(calendar-redraw))
:group 'calendar)
-(define-obsolete-variable-alias 'view-diary-entries-initially
- 'calendar-view-diary-initially-flag "23.1")
-
(defcustom calendar-view-diary-initially-flag nil
"Non-nil means display current date's diary entries on entry to calendar.
The diary is displayed in another window when the calendar is first displayed,
: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'."
(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")
: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."
: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.
(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.
These are the days on which work and school must be suspended.
(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)))
"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."
;; 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."
(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 '(0 6))
+ '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
\"\"
;; 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"]
(+ (* 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'."
"---")
(calendar-string-spread (list str) ?- width)))))
-(define-obsolete-function-alias 'calendar-version 'emacs-version "23.1")
-
(run-hooks 'calendar-load-hook)
(provide 'calendar)