Allow customization of calendar month header text

* lisp/calendar/calendar.el (calendar-american-month-header)
(calendar-european-month-header, calendar-iso-month-header)
(calendar-month-header): New options.
(calendar-set-date-style): Set calendar-month-header.  Redraw calendar.
(calendar-generate-month): Use calendar-month-header.

Fixes: debbugs:9510
This commit is contained in:
Glenn Morris 2012-09-19 00:27:29 -07:00
parent 4ef1567b27
commit 69f6644cd4
3 changed files with 78 additions and 4 deletions

View file

@ -439,6 +439,9 @@ Use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead.
** Calendar
*** You can customize the header text that appears above each calendar month.
See the variable `calendar-month-header'.
*** The calendars produced by cal-html include holidays.
Customize cal-html-holidays to change this.

View file

@ -1,3 +1,11 @@
2012-09-19 Glenn Morris <rgm@gnu.org>
* calendar/calendar.el (calendar-american-month-header)
(calendar-european-month-header, calendar-iso-month-header)
(calendar-month-header): New options.
(calendar-set-date-style): Set calendar-month-header. Redraw calendar.
(calendar-generate-month): Use calendar-month-header. (Bug#9510)
2012-09-19 Jan Djärv <jan.h.d@swipnet.se>
* startup.el (command-line-ns-option-alist): Add -g and --geometry.

View file

@ -921,6 +921,64 @@ styles."
calendar-american-date-display-form)
:group 'calendar)
(defcustom calendar-american-month-header
'(propertize (format "%s %d" (calendar-month-name month) year)
'font-lock-face 'font-lock-function-name-face)
"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")
(defcustom calendar-european-month-header
'(propertize (format "%s %d" (calendar-month-name month) year)
'font-lock-face 'font-lock-function-name-face)
"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")
(defcustom calendar-iso-month-header
'(propertize (format "%d %s" year (calendar-month-name month))
'font-lock-face 'font-lock-function-name-face)
"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")
(defcustom calendar-month-header
(cond ((eq calendar-date-style 'iso)
calendar-iso-month-header)
((eq calendar-date-style 'european)
calendar-european-month-header)
(t calendar-american-month-header))
"Expression to evaluate to return the calendar month headings.
When this expression is evaluated, the variables MONTH and YEAR are
integers appropriate to the relevant month. The result is padded
to the width of `calendar-month-digit-width'.
For examples of three common styles, see `calendar-american-month-header',
`calendar-european-month-header', and `calendar-iso-month-header'.
Changing this variable without using customize has no effect on
pre-existing calendar windows."
:group 'calendar
:initialize 'custom-initialize-default
:risky t
:set (lambda (sym val)
(set sym val)
(calendar-redraw))
:set-after '(calendar-date-style calendar-american-month-header
calendar-european-month-header
calendar-iso-month-header)
:type 'sexp
:version "24.3")
(defun calendar-set-date-style (style)
"Set the style of calendar and diary dates to STYLE (a symbol).
The valid styles are described in the documentation of `calendar-date-style'."
@ -934,8 +992,11 @@ The valid styles are described in the documentation of `calendar-date-style'."
calendar-date-display-form
(symbol-value (intern-soft
(format "calendar-%s-date-display-form" style)))
calendar-month-header
(symbol-value (intern-soft (format "calendar-%s-month-header" style)))
diary-date-forms
(symbol-value (intern-soft (format "diary-%s-date-forms" style))))
(calendar-redraw)
(calendar-update-mode-line))
(defun european-calendar ()
@ -1463,9 +1524,8 @@ line."
(goto-char (point-min))
(calendar-move-to-column indent)
(insert
(calendar-string-spread
(list (format "%s %d" (calendar-month-name month) year))
?\s calendar-month-digit-width))
(calendar-string-spread (list calendar-month-header)
?\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.
@ -2222,9 +2282,12 @@ Negative years are interpreted as years BC; -1 being 1 BC, and so on."
(- 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) ; month and year
. font-lock-function-name-face)
(,(regexp-opt
(list (substring (aref calendar-day-name-array 6)
0 calendar-day-header-width)