Commit 3b5c03d3 authored by Glenn Morris's avatar Glenn Morris

calendar.el: Add new faces, and day-header-array

* lisp/calendar/calendar.el (calendar-weekday-header)
(calendar-weekend-header, calendar-month-header): New faces.
(calendar-day-header-construct): New function.
(calendar-day-header-width): Also :set calendar-day-header-array.
(calendar-american-month-header, calendar-european-month-header)
(calendar-iso-month-header): Use calendar- faces.
(calendar-generate-month):
Use calendar-day-header-array for day headers; apply faces to them.
(calendar-mode): Check calendar-font-lock-keywords non-nil.
(calendar-abbrev-construct): Add optional maxlen argument.
(calendar-day-name-array): Doc fix.
(calendar-day-name-array, calendar-abbrev-length)
(calendar-day-abbrev-array):
Also :set calendar-day-header-array, and maybe redraw.
(calendar-day-header-array): New option. 
(calendar-font-lock-keywords): Use calendar-day-header-array,
and calendar- faces.  Make obsolete.
(calendar-day-name): Add option to use header array.

* etc/NEWS: Mention this.

Fixes: debbugs:15007
parent ec956438
......@@ -233,6 +233,13 @@ The default separator is changed to allow surrounding spaces around the comma.
** Calendar and Diary
*** New faces: `calendar-weekday-header', `calendar-weekend-header',
`calendar-month-header'.
*** New option `calendar-day-header-array'.
*** The variable `calendar-font-lock-keywords' is obsolete.
+++
*** New variable `diary-from-outlook-function', used by the command
`diary-from-outlook'.
......
2013-08-06 Glenn Morris <rgm@gnu.org>
* calendar/calendar.el: Add new faces, and day-header-array.
(calendar-weekday-header, calendar-weekend-header)
(calendar-month-header): New faces.
(calendar-day-header-construct): New function.
(calendar-day-header-width): Also :set calendar-day-header-array.
(calendar-american-month-header, calendar-european-month-header)
(calendar-iso-month-header): Use calendar- faces.
(calendar-generate-month):
Use calendar-day-header-array for day headers; apply faces to them.
(calendar-mode): Check calendar-font-lock-keywords non-nil.
(calendar-abbrev-construct): Add optional maxlen argument.
(calendar-day-name-array): Doc fix.
(calendar-day-name-array, calendar-abbrev-length)
(calendar-day-abbrev-array):
Also :set calendar-day-header-array, and maybe redraw.
(calendar-day-header-array): New option. (Bug#15007)
(calendar-font-lock-keywords): Use calendar-day-header-array,
and calendar- faces. Make obsolete.
(calendar-day-name): Add option to use header array.
2013-08-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
* net/shr.el (shr-render-td): Remove debugging.
......
......@@ -259,6 +259,23 @@ See `calendar-holiday-marker'."
(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
;; when this file is loaded shouldn't make a difference. One could
......@@ -447,7 +464,6 @@ rightmost column."
(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.
......@@ -491,12 +507,25 @@ Then redraw the calendar, if necessary."
: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")
......@@ -924,33 +953,33 @@ styles."
(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)
......@@ -1517,8 +1546,7 @@ line."
(last (calendar-last-day-of-month month year))
(trunc (min calendar-intermonth-spacing
(1- calendar-left-margin)))
(day 1)
string)
(day 1))
(goto-char (point-min))
(calendar-move-to-column indent)
(insert
......@@ -1526,13 +1554,16 @@ line."
?\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)
(insert
(progn
(setq string
(calendar-day-name (mod (+ calendar-week-start-day i) 7) nil t))
(truncate-string-to-width string calendar-day-header-width nil ?\s))
(truncate-string-to-width
(propertize (calendar-day-name (mod (+ calendar-week-start-day i) 7)
'header t)
'font-lock-face (if (memq i '(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)
......@@ -1808,8 +1839,9 @@ For a complete description, see the info node `Calendar/Diary'.
;; 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.
......@@ -2079,33 +2111,41 @@ is a string to insert in the minibuffer before reading."
(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")
......@@ -2125,7 +2165,8 @@ then you may also want to change `calendar-day-abbrev-array' and
(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
......@@ -2135,7 +2176,12 @@ then you may also want to change `calendar-day-abbrev-array' and
(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
......@@ -2152,11 +2198,17 @@ full name."
: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")
......@@ -2167,6 +2219,33 @@ full name."
;; 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"]
......@@ -2287,30 +2366,38 @@ Negative years are interpreted as years BC; -1 being 1 BC, and so on."
;; of that variable.
`((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
" -?[0-9]+")
. font-lock-function-name-face)
. 'calendar-month-header)
;; Day headers.
;; Also not needed now that calendar-generate-month uses propertize.
(,(regexp-opt
(list (truncate-string-to-width (aref calendar-day-name-array 6)
(list (truncate-string-to-width (aref calendar-day-header-array 6)
calendar-day-header-width)
(truncate-string-to-width (aref calendar-day-name-array 0)
(truncate-string-to-width (aref calendar-day-header-array 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) (truncate-string-to-width
x calendar-day-header-width))
calendar-day-name-array))
. font-lock-constant-face))
. 'calendar-weekend-header)
(,(regexp-opt (mapcar (lambda (x) (truncate-string-to-width
x calendar-day-header-width))
calendar-day-header-array))
. 'calendar-day-header))
"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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment