From e565dd3789e0ef5589035034893d99de239c87a2 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 17 May 2011 20:20:13 -0700 Subject: [PATCH] Rationalize calendar handling of day and month abbrev-arrays. * lisp/calendar/calendar.el (calendar-customized-p): New function. (calendar-abbrev-construct, calendar-make-alist): Change what it does. (calendar-day-name-array, calendar-month-name-array): Doc fix. Add :set function. (calendar-abbrev-length, calendar-day-abbrev-array) (calendar-month-abbrev-array): Make defcustoms, with appropriate :set. (calendar-day-abbrev-array, calendar-month-abbrev-array): Elements may no longer be nil. (calendar-day-name, calendar-month-name): Update for changed nature of abbrev arrays. * calendar/diary-lib.el (diary-name-pattern): Update for changed nature of abbrev arrays. (diary-mark-entries-1): Update calendar-make-alist calls. (diary-font-lock-date-forms): Doc fix for changed abbrev arrays. * calendar/cal-html.el (cal-html-day-abbrev-array): Simply inherit from calendar-day-abbrev-array. * etc/NEWS: Mention this. --- etc/NEWS | 4 + lisp/ChangeLog | 20 +++++ lisp/calendar/cal-html.el | 13 ++- lisp/calendar/calendar.el | 208 +++++++++++++++++++++++++++++---------------- lisp/calendar/diary-lib.el | 39 +++++---- 5 files changed, 187 insertions(+), 97 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 9889067fb87..9a906889530 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -473,6 +473,10 @@ See the variable `appt-warning-time-regexp'. *** New function `diary-hebrew-birthday'. --- +*** Elements of `calendar-day-abbrev-array' and `calendar-month-abbrev-array' +may no longer be nil, but must all be strings. + +--- *** The obsolete (since Emacs 22.1) method of enabling the appt package by adding appt-make-list to diary-hook has been removed. Use appt-activate. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1fc7cc88f8d..fa61c6913c2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,23 @@ +2011-05-18 Glenn Morris + + Rationalize calendar handling of day and month abbrev-arrays. + * calendar/calendar.el (calendar-customized-p): New function. + (calendar-abbrev-construct, calendar-make-alist): Change what it does. + (calendar-day-name-array, calendar-month-name-array): Doc fix. + Add :set function. + (calendar-abbrev-length, calendar-day-abbrev-array) + (calendar-month-abbrev-array): Make defcustoms, with appropriate :set. + (calendar-day-abbrev-array, calendar-month-abbrev-array): + Elements may no longer be nil. + (calendar-day-name, calendar-month-name): + Update for changed nature of abbrev arrays. + * calendar/diary-lib.el (diary-name-pattern): + Update for changed nature of abbrev arrays. + (diary-mark-entries-1): Update calendar-make-alist calls. + (diary-font-lock-date-forms): Doc fix for changed abbrev arrays. + * calendar/cal-html.el (cal-html-day-abbrev-array): + Simply inherit from calendar-day-abbrev-array. + 2011-05-17 Stefan Monnier * progmodes/grep.el (grep-mode): Disable default diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el index bcc19ccda0b..580b953170c 100644 --- a/lisp/calendar/cal-html.el +++ b/lisp/calendar/cal-html.el @@ -54,11 +54,16 @@ :type 'integer :group 'calendar-html) -(defcustom cal-html-day-abbrev-array - (calendar-abbrev-construct calendar-day-abbrev-array - calendar-day-name-array) +(defcustom cal-html-day-abbrev-array calendar-day-abbrev-array "Array of seven strings for abbreviated day names (starting with Sunday)." - :type '(vector string string string string string string string) + :set-after '(calendar-day-abbrev-array) + :type '(vector (string :tag "Sun") + (string :tag "Mon") + (string :tag "Tue") + (string :tag "Wed") + (string :tag "Thu") + (string :tag "Fri") + (string :tag "Sat")) :group 'calendar-html) (defcustom cal-html-css-default diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index e81eb554458..fa19d1ffe14 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -2034,18 +2034,40 @@ is a string to insert in the minibuffer before reading." value)) -(defvar calendar-abbrev-length 3 - "*Length of abbreviations to be used for day and month names. -See also `calendar-day-abbrev-array' and `calendar-month-abbrev-array'.") +(defun calendar-customized-p (symbol) + "Return non-nil if SYMBOL has been customized." + (and (default-boundp symbol) + (let ((standard (get symbol 'standard-value))) + (and standard + (not (equal (eval (car standard)) (default-value symbol))))))) + +(defun calendar-abbrev-construct (full) + "From sequence FULL, return a vector of abbreviations. +Each abbreviation is no longer than `calendar-abbrev-length' characters." + (apply 'vector (mapcar + (lambda (f) + (substring f 0 (min calendar-abbrev-length (length f)))) + full))) -;; FIXME does it have to start from Sunday? (defcustom calendar-day-name-array ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"] - "Array of capitalized strings giving, in order, the day names. + "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. See also the variable -`calendar-day-abbrev-array'." +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'." :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))) + (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)))) :type '(vector (string :tag "Sunday") (string :tag "Monday") (string :tag "Tuesday") @@ -2054,23 +2076,74 @@ day columns in the calendar. See also the variable (string :tag "Friday") (string :tag "Saturday"))) -(defvar calendar-day-abbrev-array - [nil nil nil nil nil nil nil] - "*Array of capitalized strings giving the abbreviated day names. +(defcustom calendar-abbrev-length 3 + "Default length of abbreviations to use for day and month names. +If you change this without using customize after the calendar has loaded, +then you may also want to change `calendar-day-abbrev-array' and +`calendar-month-abbrev-array'." + :group 'calendar + :initialize 'custom-initialize-default + :set (lambda (symbol value) + (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))) + (set symbol value) + (or dcustomized + (setq calendar-day-abbrev-array + (calendar-abbrev-construct calendar-day-name-array))) + (or mcustomized + (setq calendar-month-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)))) + :type 'integer) + +(defcustom calendar-day-abbrev-array + (calendar-abbrev-construct calendar-day-name-array) + "Array of capitalized strings giving the abbreviated day names. The order should be the same as that of the full names specified in `calendar-day-name-array'. These abbreviations may be used instead of the full names in the diary file. Do not include a trailing `.' in the strings specified in this variable, though -you may use such in the diary file. If any element of this array -is nil, then the abbreviation will be constructed as the first -`calendar-abbrev-length' characters of the corresponding full name.") +you may use such in the diary file. By default, each string is +the first `calendar-abbrev-length' characters of the corresponding +full name." + :group 'calendar + :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))) + (set symbol value) + (and (not hcustomized) + (boundp 'cal-html-day-abbrev-array) + (setq cal-html-day-abbrev-array calendar-day-abbrev-array)))) + :type '(vector (string :tag "Sun") + (string :tag "Mon") + (string :tag "Tue") + (string :tag "Wed") + (string :tag "Thu") + (string :tag "Fri") + (string :tag "Sat")) + ;; Made defcustom, changed defaults from nil nil... + :version "24.1") (defcustom calendar-month-name-array ["January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"] "Array of capitalized strings giving, in order, the month names. -See also the variable `calendar-month-abbrev-array'." +If you change this without using customize after the calendar has loaded, +then you may also want to change `calendar-month-abbrev-array'." :group 'calendar + :initialize 'custom-initialize-default + :set (lambda (symbol value) + (let ((mcustomized (calendar-customized-p + 'calendar-month-abbrev-array))) + (set symbol value) + (or mcustomized + (setq calendar-month-abbrev-array + (calendar-abbrev-construct calendar-month-name-array))))) :type '(vector (string :tag "January") (string :tag "February") (string :tag "March") @@ -2084,46 +2157,54 @@ See also the variable `calendar-month-abbrev-array'." (string :tag "November") (string :tag "December"))) -(defvar calendar-month-abbrev-array - [nil nil nil nil nil nil nil nil nil nil nil nil] - "*Array of capitalized strings giving the abbreviated month names. +(defcustom calendar-month-abbrev-array + (calendar-abbrev-construct calendar-month-name-array) + "Array of capitalized strings giving the abbreviated month names. The order should be the same as that of the full names specified in `calendar-month-name-array'. These abbreviations are used in the calendar menu entries, and can also be used in the diary file. Do not include a trailing `.' in the strings specified in -this variable, though you may use such in the diary file. If any -element of this array is nil, then the abbreviation will be -constructed as the first `calendar-abbrev-length' characters of the -corresponding full name.") - -(defun calendar-make-alist (sequence &optional start-index filter abbrevs) - "Make an assoc list corresponding to SEQUENCE. -Each element of sequence will be associated with an integer, starting -from 1, or from START-INDEX if that is non-nil. If a sequence ABBREVS -is supplied, the function `calendar-abbrev-construct' is used to -construct abbreviations corresponding to the elements in SEQUENCE. -Each abbreviation is entered into the alist with the same -association index as the full name it represents. -If FILTER is provided, apply it to each key in the alist." - (let ((index 0) - (offset (or start-index 1)) - (aseq (if abbrevs (calendar-abbrev-construct abbrevs sequence))) - (aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence - 'period))) - alist elem) - (dotimes (i (length sequence) (reverse alist)) - (setq index (+ i offset) - elem (elt sequence i) - alist - (cons (cons (if filter (funcall filter elem) elem) index) alist)) - (if aseq - (setq elem (elt aseq i) - alist (cons (cons (if filter (funcall filter elem) elem) - index) alist))) - (if aseqp - (setq elem (elt aseqp i) - alist (cons (cons (if filter (funcall filter elem) elem) - index) alist)))))) +this variable, though you may use such in the diary file. By +default, each string is the first ``calendar-abbrev-length' +characters of the corresponding full name." + :group 'calendar + :set-after '(calendar-abbrev-length calendar-month-name-array) + :type '(vector (string :tag "Jan") + (string :tag "Feb") + (string :tag "Mar") + (string :tag "Apr") + (string :tag "May") + (string :tag "Jun") + (string :tag "Jul") + (string :tag "Aug") + (string :tag "Sep") + (string :tag "Oct") + (string :tag "Nov") + (string :tag "Dec")) + ;; Made defcustom, changed defaults from nil nil... + :version "24.1") + +(defun calendar-make-alist (sequence &optional start-index filter + &rest sequences) + "Return an association list corresponding to SEQUENCE. +Associates each element of SEQUENCE with an incremented integer, +starting from START-INDEX (default 1). Applies the function FILTER, +if provided, to each key in the alist. Repeats the process, with +indices starting from START-INDEX each time, for any remaining +arguments SEQUENCES." + (or start-index (setq start-index 1)) + (let (index alist) + (mapc (lambda (seq) + (setq index start-index) + (mapc (lambda (elem) + (setq alist (cons + (cons (if filter (funcall filter elem) elem) + index) + alist) + index (1+ index))) + seq)) + (append (list sequence) sequences)) + (reverse alist))) (defun calendar-read-date (&optional noday) "Prompt for Gregorian date. Return a list (month day year). @@ -2162,23 +2243,6 @@ Negative years are interpreted as years BC; -1 being 1 BC, and so on." (+ (* 12 (- yr2 yr1)) (- mon2 mon1))) -(defun calendar-abbrev-construct (abbrev full &optional period) - "Internal calendar function to return a complete abbreviation array. -ABBREV is an array of abbreviations, FULL the corresponding array -of full names. The return value is the ABBREV array, with any nil -elements replaced by the first three characters taken from the -corresponding element of FULL. If optional argument PERIOD is non-nil, -each element returned has a final `.' character." - (let (elem array name) - (dotimes (i (length full)) - (setq name (aref full i) - elem (or (aref abbrev i) - (substring name 0 - (min calendar-abbrev-length (length name)))) - elem (format "%s%s" elem (if period "." "")) - array (append array (list elem)))) - (vconcat array))) - (defvar calendar-font-lock-keywords `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t) " -?[0-9]+") @@ -2204,10 +2268,7 @@ 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-abbrev-construct calendar-day-abbrev-array - calendar-day-name-array) - calendar-day-name-array) + (aref (if abbrev calendar-day-abbrev-array calendar-day-name-array) (if absolute date (calendar-day-of-week date)))) (defun calendar-month-name (month &optional abbrev) @@ -2216,10 +2277,7 @@ Months are numbered from one. Month names are taken from the variable `calendar-month-name-array', unless the optional argument ABBREV is non-nil, in which case `calendar-month-abbrev-array' is used." - (aref (if abbrev - (calendar-abbrev-construct calendar-month-abbrev-array - calendar-month-name-array) - calendar-month-name-array) + (aref (if abbrev calendar-month-abbrev-array calendar-month-name-array) (1- month))) (defun calendar-day-of-week (date) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 62da7579d50..f21247e9c93 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1250,19 +1250,15 @@ should ensure that all relevant variables are set. (defun diary-name-pattern (string-array &optional abbrev-array paren) "Return a regexp matching the strings in the array STRING-ARRAY. -If the optional argument ABBREV-ARRAY is present, then the function -`calendar-abbrev-construct' is used to construct abbreviations from the -two supplied arrays. The returned regexp will then also match these -abbreviations, with or without final `.' characters. If the optional -argument PAREN is non-nil, the regexp is surrounded by parentheses." +If the optional argument ABBREV-ARRAY is present, the regexp +also matches the supplied abbreviations, with or without final `.' +characters. If the optional argument PAREN is non-nil, surrounds +the regexp with parentheses." (regexp-opt (append string-array + abbrev-array (if abbrev-array - (calendar-abbrev-construct abbrev-array - string-array)) - (if abbrev-array - (calendar-abbrev-construct abbrev-array - string-array - 'period)) + (mapcar (lambda (e) (format "%s." e)) + abbrev-array)) nil) paren)) @@ -1363,7 +1359,11 @@ function that converts absolute dates to dates of the appropriate type. " (cdr (assoc-string dd-name (calendar-make-alist calendar-day-name-array - 0 nil calendar-day-abbrev-array) t)) marks) + 0 nil calendar-day-abbrev-array + (mapcar (lambda (e) + (format "%s." e)) + calendar-day-abbrev-array)) + t)) marks) (if mm-name (setq mm (if (string-equal mm-name "*") 0 @@ -1372,7 +1372,11 @@ function that converts absolute dates to dates of the appropriate type. " (if months (calendar-make-alist months) (calendar-make-alist calendar-month-name-array - 1 nil calendar-month-abbrev-array)) t))))) + 1 nil calendar-month-abbrev-array + (mapcar (lambda (e) + (format "%s." e)) + calendar-month-abbrev-array))) + t))))) (funcall markfunc mm dd yy marks)))))))) ;;;###cal-autoload @@ -2307,11 +2311,10 @@ Prefix argument ARG makes the entry nonmarking." (defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array) "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY. -If given, optional SYMBOL must be a prefix to entries. -If optional ABBREV-ARRAY is present, the abbreviations constructed -from this array by the function `calendar-abbrev-construct' are -matched (with or without a final `.'), in addition to the full month -names." +If given, optional SYMBOL must be a prefix to entries. If +optional ABBREV-ARRAY is present, also matches the abbreviations +from this array (with or without a final `.'), in addition to the +full month names." (let ((dayname (diary-name-pattern calendar-day-name-array calendar-day-abbrev-array t)) (monthname (format "\\(%s\\|\\*\\)" -- 2.11.4.GIT