Re: [PATCH] ISO weeks for calendar

Hi, Michael Welle wrote: [...] I have enhanced this a little bit. If the cursor is put into the ISO week column it can be moved back to the other columns without hassle now. Next I've fixed a problem which occurs if the user decided to use a ISO week symbol with less than 2 characters. The fixes provided by Mats Lidell are incorporated into this update. Michael diff -urN calendar.1.32/cal-iso.el calendar/cal-iso.el --- calendar.1.32/cal-iso.el 2007-04-16 07:21:44.000000000 +0200 +++ calendar/cal-iso.el 2007-07-22 09:16:13.000000000 +0200 ＠＠ -64,6 +64,7 ＠＠ (* 7 (1- week)) (if (= day 0) 6 (1- day))))) +;;;###autoload (defun calendar-iso-from-absolute (date) "Compute the `ISO commercial date' corresponding to the absolute DATE. The ISO year corresponds approximately to the Gregorian year, but weeks diff -urN 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-22 18:36:31.000000000 +0200 ＠＠ -147,6 +147,17 ＠＠ (progn (goto-line 3) (move-to-column column))) + + (if ( and calendar-display-iso-week-numbers + (or (< column 6) + (and (> column 27) + (< column 31)) + (and (> column 52) + (< column 75)))) + (progn + (re-search-forward "[0-9]?[ ]+[0-9]?[0-9][^0-9]" nil t) + (re-search-backward "[0-9]" nil t))) + (if (not (looking-at "[0-9]")) (if (and (not (looking-at " *$")) (or (< column 25) ＠＠ -310,7 +321,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 -urN 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-22 19:26:21.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,11 ＠＠ (calendar-month-name month) (calendar-year-name year month 1))) ? 20) indent t) + + (if calendar-display-iso-week-numbers + (calendar-insert-indented + (truncate-string-to-width calendar-iso-week-number-symbol 2 nil 32) + ( - 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 +2165,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 +2181,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 +2642,8 ＠＠ ;; 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 ＠＠ -2619,7 +2652,9 ＠＠ ((and (= 1 month) (= segment 2)) (1+ displayed-year)) (t displayed-year)))) (if (and (looking-at "[ 0-9]?[0-9][^0-9]") - (< 2 (count-lines (point-min) (point)))) + (< 2 (count-lines (point-min) (point))) + (or (not calendar-display-iso-week-numbers) + (> (current-column) (+ 5 (* 26 segment))))) (save-excursion (if (not (looking-at " ")) (re-search-backward "[^0-9]")) -- 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