From 3b5c03d32b5917f1d14aabeb2bf082a0451ae3da Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 6 Aug 2013 19:53:49 -0400 Subject: [PATCH] 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 --- etc/NEWS | 7 ++ lisp/ChangeLog | 22 +++++ lisp/calendar/calendar.el | 167 +++++++++++++++++++++++++++++--------- 3 files changed, 156 insertions(+), 40 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 6c0c81dc0ae..4758a4da31f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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'. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 666fab55bf4..ff9b68e1987 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,25 @@ +2013-08-06 Glenn Morris + + * 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 * net/shr.el (shr-render-td): Remove debugging. diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 40dcb25bc30..b5d06aba135 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -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) -- 2.39.2