aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2011-05-17 20:20:13 -0700
committerGlenn Morris2011-05-17 20:20:13 -0700
commite565dd3789e0ef5589035034893d99de239c87a2 (patch)
treeb28b46a59e1bcbce370f4928f7c380566420ad47
parent3c24731f34709a8a3ed11a5546ff6b0c7a958f2a (diff)
downloademacs-e565dd3789e0ef5589035034893d99de239c87a2.tar.gz
emacs-e565dd3789e0ef5589035034893d99de239c87a2.zip
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.
-rw-r--r--etc/NEWS4
-rw-r--r--lisp/ChangeLog20
-rw-r--r--lisp/calendar/cal-html.el13
-rw-r--r--lisp/calendar/calendar.el208
-rw-r--r--lisp/calendar/diary-lib.el39
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'.
473*** New function `diary-hebrew-birthday'. 473*** New function `diary-hebrew-birthday'.
474 474
475--- 475---
476*** Elements of `calendar-day-abbrev-array' and `calendar-month-abbrev-array'
477may no longer be nil, but must all be strings.
478
479---
476*** The obsolete (since Emacs 22.1) method of enabling the appt package 480*** The obsolete (since Emacs 22.1) method of enabling the appt package
477by adding appt-make-list to diary-hook has been removed. Use appt-activate. 481by adding appt-make-list to diary-hook has been removed. Use appt-activate.
478 482
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1fc7cc88f8d..fa61c6913c2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,23 @@
12011-05-18 Glenn Morris <rgm@gnu.org>
2
3 Rationalize calendar handling of day and month abbrev-arrays.
4 * calendar/calendar.el (calendar-customized-p): New function.
5 (calendar-abbrev-construct, calendar-make-alist): Change what it does.
6 (calendar-day-name-array, calendar-month-name-array): Doc fix.
7 Add :set function.
8 (calendar-abbrev-length, calendar-day-abbrev-array)
9 (calendar-month-abbrev-array): Make defcustoms, with appropriate :set.
10 (calendar-day-abbrev-array, calendar-month-abbrev-array):
11 Elements may no longer be nil.
12 (calendar-day-name, calendar-month-name):
13 Update for changed nature of abbrev arrays.
14 * calendar/diary-lib.el (diary-name-pattern):
15 Update for changed nature of abbrev arrays.
16 (diary-mark-entries-1): Update calendar-make-alist calls.
17 (diary-font-lock-date-forms): Doc fix for changed abbrev arrays.
18 * calendar/cal-html.el (cal-html-day-abbrev-array):
19 Simply inherit from calendar-day-abbrev-array.
20
12011-05-17 Stefan Monnier <monnier@iro.umontreal.ca> 212011-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
2 22
3 * progmodes/grep.el (grep-mode): Disable default 23 * 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 @@
54 :type 'integer 54 :type 'integer
55 :group 'calendar-html) 55 :group 'calendar-html)
56 56
57(defcustom cal-html-day-abbrev-array 57(defcustom cal-html-day-abbrev-array calendar-day-abbrev-array
58 (calendar-abbrev-construct calendar-day-abbrev-array
59 calendar-day-name-array)
60 "Array of seven strings for abbreviated day names (starting with Sunday)." 58 "Array of seven strings for abbreviated day names (starting with Sunday)."
61 :type '(vector string string string string string string string) 59 :set-after '(calendar-day-abbrev-array)
60 :type '(vector (string :tag "Sun")
61 (string :tag "Mon")
62 (string :tag "Tue")
63 (string :tag "Wed")
64 (string :tag "Thu")
65 (string :tag "Fri")
66 (string :tag "Sat"))
62 :group 'calendar-html) 67 :group 'calendar-html)
63 68
64(defcustom cal-html-css-default 69(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."
2034 value)) 2034 value))
2035 2035
2036 2036
2037(defvar calendar-abbrev-length 3 2037(defun calendar-customized-p (symbol)
2038 "*Length of abbreviations to be used for day and month names. 2038 "Return non-nil if SYMBOL has been customized."
2039See also `calendar-day-abbrev-array' and `calendar-month-abbrev-array'.") 2039 (and (default-boundp symbol)
2040 (let ((standard (get symbol 'standard-value)))
2041 (and standard
2042 (not (equal (eval (car standard)) (default-value symbol)))))))
2043
2044(defun calendar-abbrev-construct (full)
2045 "From sequence FULL, return a vector of abbreviations.
2046Each abbreviation is no longer than `calendar-abbrev-length' characters."
2047 (apply 'vector (mapcar
2048 (lambda (f)
2049 (substring f 0 (min calendar-abbrev-length (length f))))
2050 full)))
2040 2051
2041;; FIXME does it have to start from Sunday?
2042(defcustom calendar-day-name-array 2052(defcustom calendar-day-name-array
2043 ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"] 2053 ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]
2044 "Array of capitalized strings giving, in order, the day names. 2054 "Array of capitalized strings giving, in order from Sunday, the day names.
2045The first two characters of each string will be used to head the 2055The first two characters of each string will be used to head the
2046day columns in the calendar. See also the variable 2056day columns in the calendar.
2047`calendar-day-abbrev-array'." 2057If you change this without using customize after the calendar has loaded,
2058then you may also want to change `calendar-day-abbrev-array'."
2048 :group 'calendar 2059 :group 'calendar
2060 :initialize 'custom-initialize-default
2061 :set (lambda (symbol value)
2062 (let ((dcustomized (calendar-customized-p 'calendar-day-abbrev-array))
2063 (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array)))
2064 (set symbol value)
2065 (or dcustomized
2066 (setq calendar-day-abbrev-array
2067 (calendar-abbrev-construct calendar-day-name-array)))
2068 (and (not hcustomized)
2069 (boundp 'cal-html-day-abbrev-array)
2070 (setq cal-html-day-abbrev-array calendar-day-abbrev-array))))
2049 :type '(vector (string :tag "Sunday") 2071 :type '(vector (string :tag "Sunday")
2050 (string :tag "Monday") 2072 (string :tag "Monday")
2051 (string :tag "Tuesday") 2073 (string :tag "Tuesday")
@@ -2054,23 +2076,74 @@ day columns in the calendar. See also the variable
2054 (string :tag "Friday") 2076 (string :tag "Friday")
2055 (string :tag "Saturday"))) 2077 (string :tag "Saturday")))
2056 2078
2057(defvar calendar-day-abbrev-array 2079(defcustom calendar-abbrev-length 3
2058 [nil nil nil nil nil nil nil] 2080 "Default length of abbreviations to use for day and month names.
2059 "*Array of capitalized strings giving the abbreviated day names. 2081If you change this without using customize after the calendar has loaded,
2082then you may also want to change `calendar-day-abbrev-array' and
2083`calendar-month-abbrev-array'."
2084 :group 'calendar
2085 :initialize 'custom-initialize-default
2086 :set (lambda (symbol value)
2087 (let ((dcustomized (calendar-customized-p 'calendar-day-abbrev-array))
2088 (mcustomized (calendar-customized-p
2089 'calendar-month-abbrev-array))
2090 (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array)))
2091 (set symbol value)
2092 (or dcustomized
2093 (setq calendar-day-abbrev-array
2094 (calendar-abbrev-construct calendar-day-name-array)))
2095 (or mcustomized
2096 (setq calendar-month-abbrev-array
2097 (calendar-abbrev-construct calendar-month-name-array)))
2098 (and (not hcustomized)
2099 (boundp 'cal-html-day-abbrev-array)
2100 (setq cal-html-day-abbrev-array calendar-day-abbrev-array))))
2101 :type 'integer)
2102
2103(defcustom calendar-day-abbrev-array
2104 (calendar-abbrev-construct calendar-day-name-array)
2105 "Array of capitalized strings giving the abbreviated day names.
2060The order should be the same as that of the full names specified 2106The order should be the same as that of the full names specified
2061in `calendar-day-name-array'. These abbreviations may be used 2107in `calendar-day-name-array'. These abbreviations may be used
2062instead of the full names in the diary file. Do not include a 2108instead of the full names in the diary file. Do not include a
2063trailing `.' in the strings specified in this variable, though 2109trailing `.' in the strings specified in this variable, though
2064you may use such in the diary file. If any element of this array 2110you may use such in the diary file. By default, each string is
2065is nil, then the abbreviation will be constructed as the first 2111the first `calendar-abbrev-length' characters of the corresponding
2066`calendar-abbrev-length' characters of the corresponding full name.") 2112full name."
2113 :group 'calendar
2114 :initialize 'custom-initialize-default
2115 :set-after '(calendar-abbrev-length calendar-day-name-array)
2116 :set (lambda (symbol value)
2117 (let ((hcustomized (calendar-customized-p 'cal-html-day-abbrev-array)))
2118 (set symbol value)
2119 (and (not hcustomized)
2120 (boundp 'cal-html-day-abbrev-array)
2121 (setq cal-html-day-abbrev-array calendar-day-abbrev-array))))
2122 :type '(vector (string :tag "Sun")
2123 (string :tag "Mon")
2124 (string :tag "Tue")
2125 (string :tag "Wed")
2126 (string :tag "Thu")
2127 (string :tag "Fri")
2128 (string :tag "Sat"))
2129 ;; Made defcustom, changed defaults from nil nil...
2130 :version "24.1")
2067 2131
2068(defcustom calendar-month-name-array 2132(defcustom calendar-month-name-array
2069 ["January" "February" "March" "April" "May" "June" 2133 ["January" "February" "March" "April" "May" "June"
2070 "July" "August" "September" "October" "November" "December"] 2134 "July" "August" "September" "October" "November" "December"]
2071 "Array of capitalized strings giving, in order, the month names. 2135 "Array of capitalized strings giving, in order, the month names.
2072See also the variable `calendar-month-abbrev-array'." 2136If you change this without using customize after the calendar has loaded,
2137then you may also want to change `calendar-month-abbrev-array'."
2073 :group 'calendar 2138 :group 'calendar
2139 :initialize 'custom-initialize-default
2140 :set (lambda (symbol value)
2141 (let ((mcustomized (calendar-customized-p
2142 'calendar-month-abbrev-array)))
2143 (set symbol value)
2144 (or mcustomized
2145 (setq calendar-month-abbrev-array
2146 (calendar-abbrev-construct calendar-month-name-array)))))
2074 :type '(vector (string :tag "January") 2147 :type '(vector (string :tag "January")
2075 (string :tag "February") 2148 (string :tag "February")
2076 (string :tag "March") 2149 (string :tag "March")
@@ -2084,46 +2157,54 @@ See also the variable `calendar-month-abbrev-array'."
2084 (string :tag "November") 2157 (string :tag "November")
2085 (string :tag "December"))) 2158 (string :tag "December")))
2086 2159
2087(defvar calendar-month-abbrev-array 2160(defcustom calendar-month-abbrev-array
2088 [nil nil nil nil nil nil nil nil nil nil nil nil] 2161 (calendar-abbrev-construct calendar-month-name-array)
2089 "*Array of capitalized strings giving the abbreviated month names. 2162 "Array of capitalized strings giving the abbreviated month names.
2090The order should be the same as that of the full names specified 2163The order should be the same as that of the full names specified
2091in `calendar-month-name-array'. These abbreviations are used in 2164in `calendar-month-name-array'. These abbreviations are used in
2092the calendar menu entries, and can also be used in the diary 2165the calendar menu entries, and can also be used in the diary
2093file. Do not include a trailing `.' in the strings specified in 2166file. Do not include a trailing `.' in the strings specified in
2094this variable, though you may use such in the diary file. If any 2167this variable, though you may use such in the diary file. By
2095element of this array is nil, then the abbreviation will be 2168default, each string is the first ``calendar-abbrev-length'
2096constructed as the first `calendar-abbrev-length' characters of the 2169characters of the corresponding full name."
2097corresponding full name.") 2170 :group 'calendar
2098 2171 :set-after '(calendar-abbrev-length calendar-month-name-array)
2099(defun calendar-make-alist (sequence &optional start-index filter abbrevs) 2172 :type '(vector (string :tag "Jan")
2100 "Make an assoc list corresponding to SEQUENCE. 2173 (string :tag "Feb")
2101Each element of sequence will be associated with an integer, starting 2174 (string :tag "Mar")
2102from 1, or from START-INDEX if that is non-nil. If a sequence ABBREVS 2175 (string :tag "Apr")
2103is supplied, the function `calendar-abbrev-construct' is used to 2176 (string :tag "May")
2104construct abbreviations corresponding to the elements in SEQUENCE. 2177 (string :tag "Jun")
2105Each abbreviation is entered into the alist with the same 2178 (string :tag "Jul")
2106association index as the full name it represents. 2179 (string :tag "Aug")
2107If FILTER is provided, apply it to each key in the alist." 2180 (string :tag "Sep")
2108 (let ((index 0) 2181 (string :tag "Oct")
2109 (offset (or start-index 1)) 2182 (string :tag "Nov")
2110 (aseq (if abbrevs (calendar-abbrev-construct abbrevs sequence))) 2183 (string :tag "Dec"))
2111 (aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence 2184 ;; Made defcustom, changed defaults from nil nil...
2112 'period))) 2185 :version "24.1")
2113 alist elem) 2186
2114 (dotimes (i (length sequence) (reverse alist)) 2187(defun calendar-make-alist (sequence &optional start-index filter
2115 (setq index (+ i offset) 2188 &rest sequences)
2116 elem (elt sequence i) 2189 "Return an association list corresponding to SEQUENCE.
2117 alist 2190Associates each element of SEQUENCE with an incremented integer,
2118 (cons (cons (if filter (funcall filter elem) elem) index) alist)) 2191starting from START-INDEX (default 1). Applies the function FILTER,
2119 (if aseq 2192if provided, to each key in the alist. Repeats the process, with
2120 (setq elem (elt aseq i) 2193indices starting from START-INDEX each time, for any remaining
2121 alist (cons (cons (if filter (funcall filter elem) elem) 2194arguments SEQUENCES."
2122 index) alist))) 2195 (or start-index (setq start-index 1))
2123 (if aseqp 2196 (let (index alist)
2124 (setq elem (elt aseqp i) 2197 (mapc (lambda (seq)
2125 alist (cons (cons (if filter (funcall filter elem) elem) 2198 (setq index start-index)
2126 index) alist)))))) 2199 (mapc (lambda (elem)
2200 (setq alist (cons
2201 (cons (if filter (funcall filter elem) elem)
2202 index)
2203 alist)
2204 index (1+ index)))
2205 seq))
2206 (append (list sequence) sequences))
2207 (reverse alist)))
2127 2208
2128(defun calendar-read-date (&optional noday) 2209(defun calendar-read-date (&optional noday)
2129 "Prompt for Gregorian date. Return a list (month day year). 2210 "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."
2162 (+ (* 12 (- yr2 yr1)) 2243 (+ (* 12 (- yr2 yr1))
2163 (- mon2 mon1))) 2244 (- mon2 mon1)))
2164 2245
2165(defun calendar-abbrev-construct (abbrev full &optional period)
2166 "Internal calendar function to return a complete abbreviation array.
2167ABBREV is an array of abbreviations, FULL the corresponding array
2168of full names. The return value is the ABBREV array, with any nil
2169elements replaced by the first three characters taken from the
2170corresponding element of FULL. If optional argument PERIOD is non-nil,
2171each element returned has a final `.' character."
2172 (let (elem array name)
2173 (dotimes (i (length full))
2174 (setq name (aref full i)
2175 elem (or (aref abbrev i)
2176 (substring name 0
2177 (min calendar-abbrev-length (length name))))
2178 elem (format "%s%s" elem (if period "." ""))
2179 array (append array (list elem))))
2180 (vconcat array)))
2181
2182(defvar calendar-font-lock-keywords 2246(defvar calendar-font-lock-keywords
2183 `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t) 2247 `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
2184 " -?[0-9]+") 2248 " -?[0-9]+")
@@ -2204,10 +2268,7 @@ be an integer in the range 0 to 6 corresponding to the day of the
2204week. Day names are taken from the variable `calendar-day-name-array', 2268week. Day names are taken from the variable `calendar-day-name-array',
2205unless the optional argument ABBREV is non-nil, in which case 2269unless the optional argument ABBREV is non-nil, in which case
2206the variable `calendar-day-abbrev-array' is used." 2270the variable `calendar-day-abbrev-array' is used."
2207 (aref (if abbrev 2271 (aref (if abbrev calendar-day-abbrev-array calendar-day-name-array)
2208 (calendar-abbrev-construct calendar-day-abbrev-array
2209 calendar-day-name-array)
2210 calendar-day-name-array)
2211 (if absolute date (calendar-day-of-week date)))) 2272 (if absolute date (calendar-day-of-week date))))
2212 2273
2213(defun calendar-month-name (month &optional abbrev) 2274(defun calendar-month-name (month &optional abbrev)
@@ -2216,10 +2277,7 @@ Months are numbered from one. Month names are taken from the
2216variable `calendar-month-name-array', unless the optional 2277variable `calendar-month-name-array', unless the optional
2217argument ABBREV is non-nil, in which case 2278argument ABBREV is non-nil, in which case
2218`calendar-month-abbrev-array' is used." 2279`calendar-month-abbrev-array' is used."
2219 (aref (if abbrev 2280 (aref (if abbrev calendar-month-abbrev-array calendar-month-name-array)
2220 (calendar-abbrev-construct calendar-month-abbrev-array
2221 calendar-month-name-array)
2222 calendar-month-name-array)
2223 (1- month))) 2281 (1- month)))
2224 2282
2225(defun calendar-day-of-week (date) 2283(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.
1250 1250
1251(defun diary-name-pattern (string-array &optional abbrev-array paren) 1251(defun diary-name-pattern (string-array &optional abbrev-array paren)
1252 "Return a regexp matching the strings in the array STRING-ARRAY. 1252 "Return a regexp matching the strings in the array STRING-ARRAY.
1253If the optional argument ABBREV-ARRAY is present, then the function 1253If the optional argument ABBREV-ARRAY is present, the regexp
1254`calendar-abbrev-construct' is used to construct abbreviations from the 1254also matches the supplied abbreviations, with or without final `.'
1255two supplied arrays. The returned regexp will then also match these 1255characters. If the optional argument PAREN is non-nil, surrounds
1256abbreviations, with or without final `.' characters. If the optional 1256the regexp with parentheses."
1257argument PAREN is non-nil, the regexp is surrounded by parentheses."
1258 (regexp-opt (append string-array 1257 (regexp-opt (append string-array
1258 abbrev-array
1259 (if abbrev-array 1259 (if abbrev-array
1260 (calendar-abbrev-construct abbrev-array 1260 (mapcar (lambda (e) (format "%s." e))
1261 string-array)) 1261 abbrev-array))
1262 (if abbrev-array
1263 (calendar-abbrev-construct abbrev-array
1264 string-array
1265 'period))
1266 nil) 1262 nil)
1267 paren)) 1263 paren))
1268 1264
@@ -1363,7 +1359,11 @@ function that converts absolute dates to dates of the appropriate type. "
1363 (cdr (assoc-string dd-name 1359 (cdr (assoc-string dd-name
1364 (calendar-make-alist 1360 (calendar-make-alist
1365 calendar-day-name-array 1361 calendar-day-name-array
1366 0 nil calendar-day-abbrev-array) t)) marks) 1362 0 nil calendar-day-abbrev-array
1363 (mapcar (lambda (e)
1364 (format "%s." e))
1365 calendar-day-abbrev-array))
1366 t)) marks)
1367 (if mm-name 1367 (if mm-name
1368 (setq mm 1368 (setq mm
1369 (if (string-equal mm-name "*") 0 1369 (if (string-equal mm-name "*") 0
@@ -1372,7 +1372,11 @@ function that converts absolute dates to dates of the appropriate type. "
1372 (if months (calendar-make-alist months) 1372 (if months (calendar-make-alist months)
1373 (calendar-make-alist 1373 (calendar-make-alist
1374 calendar-month-name-array 1374 calendar-month-name-array
1375 1 nil calendar-month-abbrev-array)) t))))) 1375 1 nil calendar-month-abbrev-array
1376 (mapcar (lambda (e)
1377 (format "%s." e))
1378 calendar-month-abbrev-array)))
1379 t)))))
1376 (funcall markfunc mm dd yy marks)))))))) 1380 (funcall markfunc mm dd yy marks))))))))
1377 1381
1378;;;###cal-autoload 1382;;;###cal-autoload
@@ -2307,11 +2311,10 @@ Prefix argument ARG makes the entry nonmarking."
2307 2311
2308(defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array) 2312(defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array)
2309 "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY. 2313 "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.
2310If given, optional SYMBOL must be a prefix to entries. 2314If given, optional SYMBOL must be a prefix to entries. If
2311If optional ABBREV-ARRAY is present, the abbreviations constructed 2315optional ABBREV-ARRAY is present, also matches the abbreviations
2312from this array by the function `calendar-abbrev-construct' are 2316from this array (with or without a final `.'), in addition to the
2313matched (with or without a final `.'), in addition to the full month 2317full month names."
2314names."
2315 (let ((dayname (diary-name-pattern calendar-day-name-array 2318 (let ((dayname (diary-name-pattern calendar-day-name-array
2316 calendar-day-abbrev-array t)) 2319 calendar-day-abbrev-array t))
2317 (monthname (format "\\(%s\\|\\*\\)" 2320 (monthname (format "\\(%s\\|\\*\\)"