/[emacs]/emacs/lisp/calendar/calendar.el
ViewVC logotype

Diff of /emacs/lisp/calendar/calendar.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.147 by rost, Mon Feb 17 22:24:30 2003 UTC revision 1.148 by gm, Sun Aug 3 13:59:13 2003 UTC
# Line 1  Line 1 
1  ;;; calendar.el --- calendar functions  ;;; calendar.el --- calendar functions
2    
3  ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997,  ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997,
4  ;;      2000, 2001 Free Software Foundation, Inc.  ;;      2000, 2001, 2003 Free Software Foundation, Inc.
5    
6  ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>  ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
7  ;; Keywords: calendar  ;; Keywords: calendar
# Line 381  redisplays the diary for whatever date t Line 381  redisplays the diary for whatever date t
381  (defcustom diary-file "~/diary"  (defcustom diary-file "~/diary"
382    "*Name of the file in which one's personal diary of dates is kept.    "*Name of the file in which one's personal diary of dates is kept.
383    
384  The file's entries are lines in any of the forms  The file's entries are lines beginning with any of the forms
385    specified by the variable `american-date-diary-pattern', by default:
386    
387              MONTH/DAY              MONTH/DAY
388              MONTH/DAY/YEAR              MONTH/DAY/YEAR
# Line 389  The file's entries are lines in any of t Line 390  The file's entries are lines in any of t
390              MONTHNAME DAY, YEAR              MONTHNAME DAY, YEAR
391              DAYNAME              DAYNAME
392    
393  at the beginning of the line; the remainder of the line is the diary entry  with the remainder of the line being the diary entry string for
394  string for that date.  MONTH and DAY are one or two digit numbers, YEAR is  that date.  MONTH and DAY are one or two digit numbers, YEAR is a
395  a number and may be written in full or abbreviated to the final two digits.  number and may be written in full or abbreviated to the final two
396  If the date does not contain a year, it is generic and applies to any year.  digits (if `abbreviated-calendar-year' is non-nil).  MONTHNAME
397  DAYNAME entries apply to any date on which is on that day of the week.  and DAYNAME can be spelled in full (as specified by the variables
398  MONTHNAME and DAYNAME can be spelled in full, abbreviated to three  `calendar-month-name-array' and `calendar-day-name-array'),
399  characters (with or without a period), capitalized or not.  Any of DAY,  abbreviated (as specified by `calendar-month-abbrev-array' and
400  MONTH, or MONTHNAME, YEAR can be `*' which matches any day, month, or year,  `calendar-day-abbrev-array') with or without a period,
401  respectively.  capitalized or not.  Any of DAY, MONTH, or MONTHNAME, YEAR can be
402    `*' which matches any day, month, or year, respectively. If the
403  The European style (in which the day precedes the month) can be used  date does not contain a year, it is generic and applies to any
404  instead, if you execute `european-calendar' when in the calendar, or set  year.  A DAYNAME entry applies to the appropriate day of the week
405  `european-calendar-style' to t in your .emacs file.  The European forms are  in every week.
406    
407    The European style (in which the day precedes the month) can be
408    used instead, if you execute `european-calendar' when in the
409    calendar, or set `european-calendar-style' to t in your .emacs
410    file.  The European forms (see `european-date-diary-pattern') are
411    
412              DAY/MONTH              DAY/MONTH
413              DAY/MONTH/YEAR              DAY/MONTH/YEAR
# Line 507  See the documentation for the function ` Line 513  See the documentation for the function `
513    :type 'regexp    :type 'regexp
514    :group 'diary)    :group 'diary)
515    
516  (defcustom diary-face-attrs '(  (defcustom diary-face-attrs
517                                (" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string)    '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string)
518                                (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string)      (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string)
519                                (" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol)      (" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol)
520                                (" *\\[height:\\([-0-9a-z]+\\)\\]$" 1 :height int)      (" *\\[height:\\([-0-9a-z]+\\)\\]$" 1 :height int)
521                                (" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol)      (" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol)
522                                (" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol)      (" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol)
523                                (" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil)      (" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil)
524                                (" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil)      (" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil)
525                                (" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil)      (" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil)
526                                (" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil)      (" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil)
527                                (" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string)      (" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string)
528                                (" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string)      (" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string)
529  ;Unsupported                          (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box)      ;; Unsupported.
530  ;Unsupported                          (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple)  ;;;    (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box)
531                                )  ;;;    (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple)
532    "*A list of (regexp regnum attr attrtype) lists where the regexp says how to find the tag, the regnum says which parenthetical sub-regexp this regexp looks for, and the attr says which attribute of the face (or that this _is_ a face) is being modified."      )
533      "*A list of (regexp regnum attr attrtype) lists where the
534    regexp says how to find the tag, the regnum says which
535    parenthetical sub-regexp this regexp looks for, and the attr says
536    which attribute of the face (or that this _is_ a face) is being
537    modified."
538    :type 'sexp    :type 'sexp
539    :group 'diary)    :group 'diary)
540    
541  (defcustom diary-file-name-prefix nil  (defcustom diary-file-name-prefix nil
542    "If non-nil then each entry in the diary list will be prefixed with the name of the file in which it was defined."    "If non-nil each diary entry is prefixed with the name of the file where it is defined."
543    :type 'boolean    :type 'boolean
544    :group 'diary)    :group 'diary)
545    
# Line 551  If this variable is nil, years must be w Line 562  If this variable is nil, years must be w
562  (defcustom european-calendar-style nil  (defcustom european-calendar-style nil
563    "*Use the European style of dates in the diary and in any displays.    "*Use the European style of dates in the diary and in any displays.
564  If this variable is t, a date 1/2/1990 would be interpreted as February 1,  If this variable is t, a date 1/2/1990 would be interpreted as February 1,
565  1990.  The accepted European date styles are  1990.  The default European date styles (see `european-date-diary-pattern')
566    are
567    
568              DAY/MONTH              DAY/MONTH
569              DAY/MONTH/YEAR              DAY/MONTH/YEAR
# Line 559  If this variable is t, a date 1/2/1990 w Line 571  If this variable is t, a date 1/2/1990 w
571              DAY MONTHNAME YEAR              DAY MONTHNAME YEAR
572              DAYNAME              DAYNAME
573    
574  Names can be capitalized or not, written in full, or abbreviated to three  Names can be capitalized or not, written in full (as specified by the
575  characters with or without a period."  variable `calendar-day-name-array'), or abbreviated (as specified by
576    `calendar-day-abbrev-array') with or without a period."
577    :type 'boolean    :type 'boolean
578    :group 'diary)    :group 'diary)
579    
# Line 614  any portion of the diary entry itself, j Line 627  any portion of the diary entry itself, j
627    
628  A pseudo-pattern is a list of regular expressions and the keywords `month',  A pseudo-pattern is a list of regular expressions and the keywords `month',
629  `day', `year', `monthname', and `dayname'.  The keyword `monthname' will  `day', `year', `monthname', and `dayname'.  The keyword `monthname' will
630  match the name of the month, capitalized or not, or its three-letter  match the name of the month (see `calendar-month-name-array'), capitalized
631  abbreviation, followed by a period or not; it will also match `*'.  or not, or its user-specified abbreviation (see `calendar-month-abbrev-array'),
632  Similarly, `dayname' will match the name of the day, capitalized or not, or  followed by a period or not; it will also match `*'.  Similarly, `dayname'
633  its three-letter abbreviation, followed by a period or not.  The keywords  will match the name of the day (see `calendar-day-name-array'), capitalized or
634  `month', `day', and `year' will match those numerical values, preceded by  not, or its user-specified abbreviation (see `calendar-day-abbrev-array'),
635  arbitrarily many zeros; they will also match `*'.  followed by a period or not.  The keywords `month', `day', and `year' will
636    match those numerical values, preceded by arbitrarily many zeros; they will
637    also match `*'.
638    
639  The matching of the diary entries with the date forms is done with the  The matching of the diary entries with the date forms is done with the
640  standard syntax table from Fundamental mode, but with the `*' changed so  standard syntax table from Fundamental mode, but with the `*' changed so
# Line 1893  line." Line 1908  line."
1908       (list (format "%s %d" (calendar-month-name month) year)) ?  20)       (list (format "%s %d" (calendar-month-name month) year)) ?  20)
1909      indent t)      indent t)
1910     (calendar-insert-indented "" indent);; Go to proper spot     (calendar-insert-indented "" indent);; Go to proper spot
1911       ;; Use the first two characters of each day to head the columns.
1912     (calendar-for-loop i from 0 to 6 do     (calendar-for-loop i from 0 to 6 do
1913        (insert (calendar-day-name (mod (+ calendar-week-start-day i) 7)        (insert
1914                                   2 t))         (let ((string
1915        (insert " "))                (calendar-day-name (mod (+ calendar-week-start-day i) 7) nil t)))
1916             (if enable-multibyte-characters
1917                 (truncate-string-to-width string 2)
1918               (substring string 0 2)))
1919           " "))
1920     (calendar-insert-indented "" 0 t);; Force onto following line     (calendar-insert-indented "" 0 t);; Force onto following line
1921     (calendar-insert-indented "" indent);; Go to proper spot     (calendar-insert-indented "" indent);; Go to proper spot
1922     ;; Add blank days before the first of the month     ;; Add blank days before the first of the month
# Line 2497  If optional NODAY is t, does not ask for Line 2517  If optional NODAY is t, does not ask for
2517    (+ (* 12 (- yr2 yr1))    (+ (* 12 (- yr2 yr1))
2518       (- mon2 mon1)))       (- mon2 mon1)))
2519    
2520    (defvar calendar-abbrev-length 3
2521      "*Length of abbreviations to be used for day and month names.
2522    See also `calendar-day-abbrev-array' and `calendar-month-abbrev-array'.")
2523    
2524  (defvar calendar-day-name-array  (defvar calendar-day-name-array
2525    ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]    ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]
2526    "Array of capitalized strings giving, in order, the day names.")    "*Array of capitalized strings giving, in order, the day names.
2527    The first two characters of each string will be used to head the
2528    day columns in the calendar.  See also the variable
2529    `calendar-day-abbrev-array'.")
2530    
2531    (defvar calendar-day-abbrev-array
2532      [nil nil nil nil nil nil nil]
2533      "*Array of capitalized strings giving the abbreviated day names.
2534    The order should be the same as that of the full names specified
2535    in `calendar-day-name-array'.  These abbreviations may be used
2536    instead of the full names in the diary file.  Do not include a
2537    trailing `.' in the strings specified in this variable, though
2538    you may use such in the diary file.  If any element of this array
2539    is nil, then the abbreviation will be constructed as the first
2540    `calendar-abbrev-length' characters of the corresponding full name.")
2541    
2542  (defvar calendar-month-name-array  (defvar calendar-month-name-array
2543    ["January" "February" "March"     "April"   "May"      "June"    ["January" "February" "March"     "April"   "May"      "June"
2544     "July"    "August"   "September" "October" "November" "December"]     "July"    "August"   "September" "October" "November" "December"]
2545    "Array of capitalized strings giving, in order, the month names.")    "*Array of capitalized strings giving, in order, the month names.
2546    See also the variable `calendar-month-abbrev-array'.")
2547    
2548    (defvar calendar-month-abbrev-array
2549      [nil nil nil nil nil nil nil nil nil nil nil nil]
2550     "*Array of capitalized strings giving the abbreviated month names.
2551    The order should be the same as that of the full names specified
2552    in `calendar-month-name-array'.  These abbreviations are used in
2553    the calendar menu entries, and can also be used in the diary
2554    file.  Do not include a trailing `.' in the strings specified in
2555    this variable, though you may use such in the diary file.  If any
2556    element of this array is nil, then the abbreviation will be
2557    constructed as the first `calendar-abbrev-length' characters of the
2558    corresponding full name.")
2559    
2560    (defun calendar-abbrev-construct (abbrev full &optional period)
2561      "Internal calendar function to return a complete abbreviation array.
2562    ABBREV is an array of abbreviations, FULL the corresponding array
2563    of full names.  The return value is the ABBREV array, with any nil
2564    elements replaced by the first three characters taken from the
2565    corresponding element of FULL.  If optional argument PERIOD is non-nil,
2566    each element returned has a final `.' character."
2567      (let (elem array)
2568        (dotimes (i (length full))
2569          (setq elem (or (aref abbrev i)
2570                         (substring (aref full i) 0 calendar-abbrev-length))
2571                elem (format "%s%s" elem (if period "." ""))
2572                array (append array (list elem))))
2573        (vconcat array)))
2574    
2575  (defvar calendar-font-lock-keywords  (defvar calendar-font-lock-keywords
2576    `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)    `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
# Line 2515  If optional NODAY is t, does not ask for Line 2581  If optional NODAY is t, does not ask for
2581               (substring (aref calendar-day-name-array 0) 0 2)))               (substring (aref calendar-day-name-array 0) 0 2)))
2582       ;; Saturdays and Sundays are hilited differently.       ;; Saturdays and Sundays are hilited differently.
2583       . font-lock-comment-face)       . font-lock-comment-face)
2584        ;; First two chars of each day are used in the calendar.
2585      (,(regexp-opt (mapcar (lambda (x) (substring x 0 2)) calendar-day-name-array))      (,(regexp-opt (mapcar (lambda (x) (substring x 0 2)) calendar-day-name-array))
2586       . font-lock-reference-face))       . font-lock-reference-face))
2587    "Default keywords to highlight in Calendar mode.")    "Default keywords to highlight in Calendar mode.")
2588    
2589  (defun calendar-day-name (date &optional width absolute)  (defun calendar-day-name (date &optional abbrev absolute)
2590    "Return a string with the name of the day of the week of DATE.    "Return a string with the name of the day of the week of DATE.
2591  If WIDTH is non-nil, return just the first WIDTH characters of the name.  DATE should be a list in the format (MONTH DAY YEAR), unless the
2592  If ABSOLUTE is non-nil, then DATE is actually the day-of-the-week  optional argument ABSOLUTE is non-nil, in which case DATE should
2593  rather than a date."  be an integer in the range 0 to 6 corresponding to the day of the
2594    (let ((string (aref calendar-day-name-array  week.  Day names are taken from the variable `calendar-day-name-array',
2595                        (if absolute date (calendar-day-of-week date)))))  unless the optional argument ABBREV is non-nil, in which case
2596      (cond ((null width) string)  the variable `calendar-day-abbrev-array' is used."
2597            (enable-multibyte-characters (truncate-string-to-width string width))    (aref (if abbrev
2598            (t (substring string 0 width)))))              (calendar-abbrev-construct calendar-day-abbrev-array
2599                                           calendar-day-name-array)
2600              calendar-day-name-array)
2601            (if absolute date (calendar-day-of-week date))))
2602    
2603  (defun calendar-make-alist (sequence &optional start-index filter)  (defun calendar-make-alist (sequence &optional start-index filter abbrevs)
2604    "Make an assoc list corresponding to SEQUENCE.    "Make an assoc list corresponding to SEQUENCE.
2605  Start at index 1, unless optional START-INDEX is provided.  Each element of sequence will be associated with an integer, starting
2606  If FILTER is provided, apply it to each item in the list."  from 1, or from START-INDEX if that is non-nil.  If a sequence ABBREVS
2607    (let ((index (if start-index (1- start-index) 0)))  is supplied, the function `calendar-abbrev-construct' is used to
2608      (mapcar  construct abbreviations corresponding to the elements in SEQUENCE.
2609       (lambda (x)  Each abbreviation is entered into the alist with the same
2610          (setq index (1+ index))  association index as the full name it represents.
2611          (cons (if filter (funcall filter x) x)  If FILTER is provided, apply it to each key in the alist."
2612                index))    (let ((index 0)
2613       (append sequence nil))))          (offset (or start-index 1))
2614            (aseq (if abbrevs (calendar-abbrev-construct abbrevs sequence)))
2615  (defun calendar-month-name (month &optional width)          (aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence
2616    "The name of MONTH.                                                        'period)))
2617  If WIDTH is non-nil, return just the first WIDTH characters of the name."          alist elem)
2618    (let ((string (aref calendar-month-name-array (1- month))))      (dotimes (i (1- (length sequence)) (reverse alist))
2619      (if width        (setq index (+ i offset)
2620          (let ((i 0) (result "") (pos 0))              elem (elt sequence i)
2621            (while (< i width)              alist
2622              (let ((chartext (char-to-string (aref string pos))))              (cons (cons (if filter (funcall filter elem) elem) index) alist))
2623                (setq pos (+ pos (length chartext)))        (if aseq
2624                (setq result (concat result chartext)))            (setq elem (elt aseq i)
2625              (setq i (1+ i)))                  alist (cons (cons (if filter (funcall filter elem) elem)
2626            result)                                    index) alist)))
2627        string)))        (if aseqp
2628              (setq elem (elt aseqp i)
2629                    alist (cons (cons (if filter (funcall filter elem) elem)
2630                                      index) alist))))))
2631    
2632    (defun calendar-month-name (month &optional abbrev)
2633      "Return a string with the name of month number MONTH.
2634    Months are numbered from one.  Month names are taken from the
2635    variable `calendar-month-name-array', unless the optional
2636    argument ABBREV is non-nil, in which case
2637    `calendar-month-abbrev-array' is used."
2638      (aref (if abbrev
2639                (calendar-abbrev-construct calendar-month-abbrev-array
2640                                           calendar-month-name-array)
2641              calendar-month-name-array)
2642            (1- month)))
2643    
2644  (defun calendar-day-of-week (date)  (defun calendar-day-of-week (date)
2645    "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc."    "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc."
# Line 2665  The actual dates are in the car of DATE1 Line 2750  The actual dates are in the car of DATE1
2750    
2751  (defun calendar-date-string (date &optional abbreviate nodayname)  (defun calendar-date-string (date &optional abbreviate nodayname)
2752    "A string form of DATE, driven by the variable `calendar-date-display-form'.    "A string form of DATE, driven by the variable `calendar-date-display-form'.
2753  An optional parameter ABBREVIATE, when t, causes the month and day names to be  An optional parameter ABBREVIATE, when non-nil, causes the month
2754  abbreviated to three characters.  An optional parameter NODAYNAME, when t,  and day names to be abbreviated as specified by
2755  omits the name of the day of the week."  `calendar-month-abbrev-array' and `calendar-day-abbrev-array',
2756    respectively.  An optional parameter NODAYNAME, when t, omits the
2757    name of the day of the week."
2758    (let* ((dayname    (let* ((dayname
2759            (if nodayname            (unless nodayname
2760                nil              (calendar-day-name date abbreviate)))
             (if abbreviate  
                 (calendar-day-name date 3)  
               (calendar-day-name date))))  
2761           (month (extract-calendar-month date))           (month (extract-calendar-month date))
2762           (monthname           (monthname (calendar-month-name month abbreviate))
           (if abbreviate  
               (calendar-month-name month 3)  
             (calendar-month-name month)))  
2763           (day (int-to-string (extract-calendar-day date)))           (day (int-to-string (extract-calendar-day date)))
2764           (month (int-to-string month))           (month (int-to-string month))
2765           (year (int-to-string (extract-calendar-year date))))           (year (int-to-string (extract-calendar-year date))))

Legend:
Removed from v.1.147  
changed lines
  Added in v.1.148

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26