[PATCH] ISO weeks for calendar
Michael Welle
m.welle at gmx.net
Sun Jul 22 13:43:09 EDT 2007
Hi,
Michael Welle wrote:
>
> Hi Mats,
>
> Mats Lidell wrote:
[...]
> > ======================================================================
> > * 2 -- The week numbers are accepted as valid dates causing
> > insert-diary-entry to behave odd. Should be "Not a valid date" just
> > as if doing the same on other bad positions in the buffer I think.
> >
> > This is what I came up with -- Ignore the match if in iso week
> > columns. Please check and improve. (Partial patch: Just the defun
> > calendar-insert-indented included.)
> Good catch.
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
More information about the XEmacs-Patches
mailing list