[PATCH] ISO weeks for calendar

Hi, several moons ago I hacked up calendar mode to display the ISO or business weeks within the calendar. Yesterday I decide that it's time to update my XEmacs packages. Result: calendar hack is gone with the wind ;). So I do it again and to prevent me from shooting me in the foot again I submit this hack as a patch. The extension to calendar mode comes with two customization options: calendar-display-iso-week-numbers: If it is set to t, ISO weeks are displayed within the calendar. Defaults to nil. calendar-iso-week-number-symbol: String used to mark the ISO week column. Defaults to 'KW'. Perhaps some kind soul (who has deeper lisp knowledge than I have) may find this useful and can do a review of this piece of code. I hope to see it in the calendar package someday. Michael diff -u -r -N calendar.1.32/cal-move.el calendar/cal-move.el --- calendar.1.32/cal-move.el 2007-04-16 07:21:44.000000000 +0200 +++ calendar/cal-move.el 2007-07-21 19:53:06.000000000 +0200 ＠＠ -310,7 +310,7 ＠＠ 7)) 7))) (move-to-column (+ 6 - (* 25 + (* (if calendar-display-iso-week-numbers 26 25) (1+ (calendar-interval displayed-month displayed-year month year))) (* 3 (mod diff -u -r -N calendar.1.32/calendar.el calendar/calendar.el --- calendar.1.32/calendar.el 2007-04-16 07:21:44.000000000 +0200 +++ calendar/calendar.el 2007-07-21 20:30:54.000000000 +0200 ＠＠ -687,6 +687,20 ＠＠ :type 'sexp :group 'calendar) +;;;###autoload +(defcustom calendar-display-iso-week-numbers nil + "If this variable is t, the ISO 8601 week numbers are displayed within +the calendar." +:type 'boolean +:group 'calendar) + +;;;###autoload +(defcustom calendar-iso-week-number-symbol "KW" + "The first two characters of this string are used to mark the +ISO 8601 week number column." +:type 'string +:group 'calendar) + (defcustom calendar-date-display-form (if european-calendar-style european-calendar-display-form ＠＠ -2093,6 +2107,12 ＠＠ (run-hooks 'today-visible-calendar-hook) (run-hooks 'today-invisible-calendar-hook))))) +(defun get-iso-week(day month year) + (let* ((d (calendar-absolute-from-gregorian + (list month day year))) + (iso-date (calendar-iso-from-absolute d))) + (extract-calendar-month iso-date))) + (defun generate-calendar (month year) "Generate a three-month Gregorian calendar centered around MONTH, YEAR." ;;; A negative YEAR is interpreted as BC; -1 being 1 BC, and so on. ＠＠ -2106,7 +2126,7 ＠＠ (erase-buffer) (increment-calendar-month month year -1) (calendar-for-loop i from 0 to 2 do - (generate-calendar-month month year (+ 5 (* 25 i))) + (generate-calendar-month month year (+ 5 (* (if calendar-display-iso-week-numbers 26 25) i))) (increment-calendar-month month year 1))) (defun generate-calendar-month (month year indent) ＠＠ -2129,6 +2149,9 ＠＠ (calendar-month-name month) (calendar-year-name year month 1))) ? 20) indent t) + + (if calendar-display-iso-week-numbers + (calendar-insert-indented (substring calendar-iso-week-number-symbol 0 2) ( - indent 3 ))) (calendar-insert-indented "" indent);; Go to proper spot ;; Use the first two characters of each day to head the columns. (calendar-for-loop i from 0 to 6 do ＠＠ -2140,7 +2163,10 ＠＠ (substring string 0 2))) " ")) (calendar-insert-indented "" 0 t);; Force onto following line - (calendar-insert-indented "" indent);; Go to proper spot + (if calendar-display-iso-week-numbers + (calendar-insert-indented + ( number-to-string ( get-iso-week 1 month year ) ) ( - indent 3 ))) + (calendar-insert-indented "" indent );; Go to proper spot ;; Add blank days before the first of the month (calendar-for-loop i from 1 to blank-days do (insert " ")) ;; Put in the days of the month ＠＠ -2153,9 +2179,13 ＠＠ '(mouse-face highlight help-echo "mouse-2: menu of operations for this date")) (and (zerop (mod (+ i blank-days) 7)) + (setq d i) (/= i last) (calendar-insert-indented "" 0 t) ;; Force onto following line - (calendar-insert-indented "" indent)))));; Go to proper spot + (if calendar-display-iso-week-numbers + (calendar-insert-indented + (number-to-string (get-iso-week (1+ d) month year)) (- indent 3)) t) + (calendar-insert-indented "" indent )))));; Go to proper spot (defun calendar-insert-indented (string indent &optional newline) "Insert STRING at column INDENT. ＠＠ -2610,7 +2640,7 ＠＠ ;; changes allowing that to be in another frame. ; (if (not (number-or-marker-p displayed-month)) ; nil - (let* ((segment (/ (current-column) 25)) + (let* ((segment (/ (current-column) (if calendar-display-iso-week-numbers 26 25))) (month (% (+ displayed-month segment -1) 12)) (month (if (= 0 month) 12 month)) (year -- biff4emacsen - A biff-like tool for (X)Emacs http://www.c0t0d0s0.de/biff4emacsen/biff4emacsen.html _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches