From 69f6644cd4c2eb5856be503705d7f502422b215c Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 19 Sep 2012 00:27:29 -0700 Subject: [PATCH] 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 --- etc/NEWS | 3 ++ lisp/ChangeLog | 8 +++++ lisp/calendar/calendar.el | 71 ++++++++++++++++++++++++++++++++++++--- 3 files changed, 78 insertions(+), 4 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 15c06181a9a..b63430b0803 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index da45cadba46..93b25f21dc1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2012-09-19 Glenn Morris + + * 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 * startup.el (command-line-ns-option-alist): Add -g and --geometry. diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index cdbf8d7aa86..93ef440541e 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -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) -- 2.39.2