* Re: [PATCH] Quarters added to clocktables
2010-11-29 9:22 ` Erwin Vrolijk
@ 2010-11-29 9:39 ` Carsten Dominik
2010-11-29 10:29 ` Carsten Dominik
1 sibling, 0 replies; 5+ messages in thread
From: Carsten Dominik @ 2010-11-29 9:39 UTC (permalink / raw)
To: Erwin Vrolijk; +Cc: emacs-orgmode
Hi Erwin,
I cannot get the patch to apply, probably because the mailer is
destroying it.
Can you please put the patch into a file and send it to me as an
attachment?
Thanks.
- Carsten
On Nov 29, 2010, at 10:22 AM, Erwin Vrolijk wrote:
> Hi Carsten,
>
> Thank you for your feedback. The FSF papers are no problem, i've
> already got them by mail.
> Here are the new patches, patched to the current HEAD.
>
> Regards,
> Erwin Vrolijk
> Snow B.V.
>
> diff --git a/doc/org.texi b/doc/org.texi
> index 17d6e65..a4073d0 100644
> --- a/doc/org.texi
> +++ b/doc/org.texi
> @@ -5820,6 +5820,7 @@ be selected:
> 2007-12-31 @r{New year eve 2007}
> 2007-12 @r{December 2007}
> 2007-W50 @r{ISO-week 50 in 2007}
> + 2007-Q2 @r{2nd quarter in 2007}
> 2007 @r{the year 2007}
> today, yesterday, today-@var{N} @r{a relative
> day}
> thisweek, lastweek, thisweek-@var{N} @r{a relative
> week}
>
> diff --git a/lisp/org-clock.el b/lisp/org-clock.el
> index e798027..a7c4a97 100644
> --- a/lisp/org-clock.el
> +++ b/lisp/org-clock.el
> @@ -1654,6 +1654,65 @@ buffer and update it."
> (>= (match-end 0) pos)
> start))))
> +(defun org-day-of-week (day month year)
> + "Returns the day of the week as an integer."
> + (nth 6
> + (decode-time
> + (date-to-time
> + (format "%d-%02d-%02dT00:00:00" year month day)))))
> +
> +(defun org-quarter-to-date (quarter year)
> + "Get the date (week day year) of the first day of a given quarter."
> + (cond
> + ((= quarter 1)
> + (setq startday (org-day-of-week 1 1 year))
> + (cond
> + ((= startday 0)
> + (list 52 7 (- year 1)))
> + ((= startday 6)
> + (list 52 6 (- year 1)))
> + ((<= startday 4)
> + (list 1 startday year))
> + ((> startday 4)
> + (list 53 startday (- year 1)))
> + )
> + )
> + ((= quarter 2)
> + (setq startday (org-day-of-week 1 4 year))
> + (cond
> + ((= startday 0)
> + (list 13 startday year))
> + ((< startday 4)
> + (list 14 startday year))
> + ((>= startday 4)
> + (list 13 startday year))
> + )
> + )
> + ((= quarter 3)
> + (setq startday (org-day-of-week 1 7 year))
> + (cond
> + ((= startday 0)
> + (list 26 startday year))
> + ((< startday 4)
> + (list 27 startday year))
> + ((>= startday 4)
> + (list 26 startday year))
> + )
> + )
> + ((= quarter 4)
> + (setq startday (org-day-of-week 1 10 year))
> + (cond
> + ((= startday 0)
> + (list 39 startday year))
> + ((<= startday 4)
> + (list 40 startday year))
> + ((> startday 4)
> + (list 39 startday year))
> + )
> + )
> + )
> + )
> +
> (defun org-clock-special-range (key &optional time as-strings)
> "Return two times bordering a special time range.
> Key is a symbol specifying the range and can be one of `today',
> `yesterday',
> @@ -1670,6 +1729,10 @@ the returned times will be formatted strings."
> (dow (nth 6 tm))
> (skey (symbol-name key))
> (shift 0)
> + (q (cond ((>= (nth 4 tm) 10) 4)
> + ((>= (nth 4 tm) 7) 3)
> + ((>= (nth 4 tm) 4) 2)
> + ((>= (nth 4 tm) 1) 1)))
> s1 m1 h1 d1 month1 y1 diff ts te fm txt w date)
> (cond
> ((string-match "^[0-9]+$" skey)
> @@ -1687,6 +1750,15 @@ the returned times will be formatted strings."
> (setq d (nth 1 date) month (car date) y (nth 2 date)
> dow 1
> key 'week))
> + ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
> + (require 'cal-iso)
> + (setq y (string-to-number (match-string 1 skey)))
> + (setq q (string-to-number (match-string 2 skey)))
> + (setq date (calendar-gregorian-from-absolute
> + (calendar-absolute-from-iso (org-quarter-to-date
> q y))))
> + (setq d (nth 1 date) month (car date) y (nth 2 date)
> + dow 1
> + key 'quarter))
> ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\
> \{1,2\\}\\)$" skey)
> (setq y (string-to-number (match-string 1 skey))
> month (string-to-number (match-string 2 skey))
> @@ -1694,12 +1766,17 @@ the returned times will be formatted strings."
> key 'day))
> ((string-match "\\([-+][0-9]+\\)$" skey)
> (setq shift (string-to-number (match-string 1 skey))
> - key (intern (substring skey 0 (match-beginning 1))))))
> + key (intern (substring skey 0 (match-beginning 1))))
> + (if(and (memq key '(quarter thisq)) (> shift 0))
> + (error "Looking forward with quarters isn't implemented.")
> + ())))
> +
> (when (= shift 0)
> - (cond ((eq key 'yesterday) (setq key 'today shift -1))
> - ((eq key 'lastweek) (setq key 'week shift -1))
> - ((eq key 'lastmonth) (setq key 'month shift -1))
> - ((eq key 'lastyear) (setq key 'year shift -1))))
> + (cond ((eq key 'yesterday) (setq key 'today shift -1))
> + ((eq key 'lastweek) (setq key 'week shift -1))
> + ((eq key 'lastmonth) (setq key 'month shift -1))
> + ((eq key 'lastyear) (setq key 'year shift -1))
> + ((eq key 'lastq) (setq key 'quarter shift -1))))
> (cond
> ((memq key '(day today))
> (setq d (+ d shift) h 0 m 0 h1 24 m1 0))
> @@ -1708,6 +1785,28 @@ the returned times will be formatted strings."
> m 0 h 0 d (- d diff) d1 (+ 7 d)))
> ((memq key '(month thismonth))
> (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month)
> h1 0 m1 0))
> + ((memq key '(quarter thisq))
> + ; compute if this shift remains in this year
> + ; if not, compute how many years and quarters we have to
> shift (via floor*)
> + ; and compute the shifted years, months and quarters
> + (cond
> + ((< (+ (- q 1) shift) 0) ; shift not in this year
> + (setq interval (* -1 (+ (- q 1) shift)))
> + ; set tmp to ((years to shift) (quarters to shift))
> + (setq tmp (floor* interval 4))
> + ; due to the use of floor, 0 quarters actually means 4
> + (if (= 0 (nth 1 tmp))
> + (setq shiftedy (- y (nth 0 tmp))
> + shiftedm 1
> + shiftedq 1)
> + (setq shiftedy (- y (+ 1 (nth 0 tmp)))
> + shiftedm (- 13 (* 3 (nth 1 tmp)))
> + shiftedq (- 5 (nth 1 tmp))))
> + (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm)
> h1 0 m1 0 y shiftedy))
> + ((> (+ q shift) 0) ; shift is whitin this year
> + (setq shiftedq (+ q shift))
> + (setq shiftedy y)
> + (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1)))
> month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
> ((memq key '(year thisyear))
> (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
> (t (error "No such time block %s" key)))
> @@ -1723,11 +1822,21 @@ the returned times will be formatted strings."
> ((memq key '(month thismonth))
> (setq txt (format-time-string "%B %Y" ts)))
> ((memq key '(year thisyear))
> - (setq txt (format-time-string "the year %Y" ts))))
> + (setq txt (format-time-string "the year %Y" ts)))
> + ((memq key '(quarter thisq))
> + (setq txt (concatenate 'string (org-count-quarter shiftedq) "
> quarter of " (number-to-string shiftedy))))
> + )
> (if as-strings
> (list (format-time-string fm ts) (format-time-string fm te) txt)
> (list ts te txt))))
> +(defun org-count-quarter (n)
> + (cond
> + ((= n 1) "1st")
> + ((= n 2) "2nd")
> + ((= n 3) "3rd")
> + ((= n 4) "4th")))
> +
> (defun org-clocktable-shift (dir n)
> "Try to shift the :block date of the clocktable at point.
> Point must be in the #+BEGIN: line of a clocktable, or this function
> @@ -1750,45 +1859,63 @@ the currently selected interval size."
> ((equal s "yesterday") (setq s "today-1"))
> ((equal s "lastweek") (setq s "thisweek-1"))
> ((equal s "lastmonth") (setq s "thismonth-1"))
> - ((equal s "lastyear") (setq s "thisyear-1")))
> - (cond
> - ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\)\
> \([-+][0-9]+\\)?$" s)
> - (setq block (match-string 1 s)
> - shift (if (match-end 2)
> - (string-to-number (match-string 2 s))
> - 0))
> - (setq shift (+ shift n))
> - (setq ins (if (= shift 0) block (format "%s%+d" block shift))))
> - ((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\\}\\)
> \\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
> - ;; 1 1 2 3 3 4
> 4 5 6 6 5 2
> - (setq y (string-to-number (match-string 1 s))
> - wp (and (match-end 3) (match-string 3 s))
> - mw (and (match-end 4) (string-to-number (match-string 4 s)))
> - d (and (match-end 6) (string-to-number (match-string 6 s))))
> - (cond
> - (d (setq ins (format-time-string
> - "%Y-%m-%d"
> - (encode-time 0 0 0 (+ d n) m y))))
> - ((and wp mw (> (length wp) 0))
> - (require 'cal-iso)
> - (setq date (calendar-gregorian-from-absolute (calendar-
> absolute-from-iso (list (+ mw n) 1 y))))
> - (setq ins (format-time-string
> - "%G-W%V"
> - (encode-time 0 0 0 (nth 1 date) (car date) (nth 2
> date)))))
> - (mw
> - (setq ins (format-time-string
> - "%Y-%m"
> - (encode-time 0 0 0 1 (+ mw n) y))))
> - (y
> - (setq ins (number-to-string (+ y n))))))
> - (t (error "Cannot shift clocktable block")))
> - (when ins
> - (goto-char b)
> - (insert ins)
> - (delete-region (point) (+ (point) (- e b)))
> - (beginning-of-line 1)
> - (org-update-dblock)
> - t)))))
> + ((equal s "lastyear") (setq s "thisyear-1"))
> + ((equal s "lastq") (setq s "thisq-1")))
> +
> + (cond
> + ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\
> \|thisq\\)\\([-+][0-9]+\\)?$" s)
> + (setq block (match-string 1 s)
> + shift (if (match-end 2)
> + (string-to-number (match-string 2 s))
> + 0))
> + (setq shift (+ shift n))
> + (setq ins (if (= shift 0) block (format "%s%+d" block
> shift))))
> + ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\
> \)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
> + ;; 1 1 2 3 3
> 4 4 5 6 6 5 2
> + (setq y (string-to-number (match-string 1 s))
> + wp (and (match-end 3) (match-string 3 s))
> + mw (and (match-end 4) (string-to-number (match-
> string 4 s)))
> + d (and (match-end 6) (string-to-number (match-string 6
> s))))
> + (cond
> + (d (setq ins (format-time-string
> + "%Y-%m-%d"
> + (encode-time 0 0 0 (+ d n) m y))))
> + ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
> + (require 'cal-iso)
> + (setq date (calendar-gregorian-from-absolute (calendar-
> absolute-from-iso (list (+ mw n) 1 y))))
> + (setq ins (format-time-string
> + "%G-W%V"
> + (encode-time 0 0 0 (nth 1 date) (car date)
> (nth 2 date)))))
> + ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
> + (require 'cal-iso)
> + ; if the 4th + 1 quarter is requested we flip to the 1st
> quarter of the next year
> + (if (> (+ mw n) 4)
> + (setq mw 0
> + y (+ 1 y))
> + ())
> + ; if the 1st - 1 quarter is requested we flip to the 4th
> quarter of the previous year
> + (if (= (+ mw n) 0)
> + (setq mw 5
> + y (- y 1))
> + ())
> + (setq date (calendar-gregorian-from-absolute (calendar-
> absolute-from-iso (org-quarter-to-date (+ mw n) y))))
> + (setq ins (format-time-string
> + (concatenate 'string (number-to-string y) "-
> Q" (number-to-string (+ mw n)))
> + (encode-time 0 0 0 (nth 1 date) (car date)
> (nth 2 date)))))
> + (mw
> + (setq ins (format-time-string
> + "%Y-%m"
> + (encode-time 0 0 0 1 (+ mw n) y))))
> + (y
> + (setq ins (number-to-string (+ y n))))))
> + (t (error "Cannot shift clocktable block")))
> + (when ins
> + (goto-char b)
> + (insert ins)
> + (delete-region (point) (+ (point) (- e b)))
> + (beginning-of-line 1)
> + (org-update-dblock)
> + t)))))
> (defun org-dblock-write:clocktable (params)
> "Write the standard clocktable."
>
>
>
> Carsten Dominik wrote:
>> Hi Erwin,
>>
>> this patch looks good. However, it does not apply cleanly to the
>> current head, and I need to ask you to sign the FSF papers for it.
>> Are you willing to do this?
>>
>> Thanks
>>
>> - Carsten
>>
>> On Nov 19, 2010, at 2:00 PM, Erwin Vrolijk wrote:
>>
>>> Hi,
>>>
>>> I'm proud to present my first patch to orgmode.
>>> With this patch quarters are added to clocktables. It is now
>>> possible to show data for a quarter via the following syntax:
>>>
>>> :block thisq[-n] or
>>> :block lastq
>>> :block 2010-Q2
>>>
>>> Other places where quarters might be handy (for instance repeating
>>> events quarterly) are still todo.
>>>
>>> I've patched two files, the main file lisp/org-clock.el and the
>>> documentation in doc/org.texti
>>>
>>> Regards,
>>> Erwin Vrolijk
>>> http://snow.nl
>>>
>>> diff --git a/doc/org.texi b/doc/org.texi
>>> index 06583d7..5f07dbd 100644
>>> --- a/doc/org.texi
>>> +++ b/doc/org.texi
>>> @@ -5820,6 +5820,7 @@ be selected:
>>> 2007-12-31 @r{New year eve 2007}
>>> 2007-12 @r{December 2007}
>>> 2007-W50 @r{ISO-week 50 in 2007}
>>> + 2007-Q2 @r{2nd quarter in 2007}
>>> 2007 @r{the year 2007}
>>> today, yesterday, today-@var{N} @r{a relative
>>> day}
>>> thisweek, lastweek, thisweek-@var{N} @r{a relative
>>> week}
>>>
>>>
>>> diff --git a/lisp/org-clock.el b/lisp/org-clock.el
>>> index 3146926..1301fb8 100644
>>> --- a/lisp/org-clock.el
>>> +++ b/lisp/org-clock.el
>>> @@ -1653,6 +1653,64 @@ buffer and update it."
>>> (re-search-forward "^[ \t]+#\\+END:.*" nil t)
>>> (>= (match-end 0) pos)
>>> start))))
>>> +(defun org-day-of-week (day month year)
>>> + "Returns the day of the week as an integer."
>>> + (nth 6
>>> + (decode-time
>>> + (date-to-time
>>> + (format "%d-%02d-%02dT00:00:00" year month day)))))
>>> +
>>> +(defun org-quarter-to-date (quarter year)
>>> + "Get the date (week day year) of the first day of a given
>>> quarter."
>>> + (cond
>>> + ((= quarter 1)
>>> + (setq startday (org-day-of-week 1 1 year))
>>> + (cond
>>> + ((= startday 0)
>>> + (list 52 7 (- year 1)))
>>> + ((= startday 6)
>>> + (list 52 6 (- year 1)))
>>> + ((<= startday 4)
>>> + (list 1 startday year))
>>> + ((> startday 4)
>>> + (list 53 startday (- year 1)))
>>> + )
>>> + )
>>> + ((= quarter 2)
>>> + (setq startday (org-day-of-week 1 4 year))
>>> + (cond
>>> + ((= startday 0)
>>> + (list 13 startday year))
>>> + ((< startday 4)
>>> + (list 14 startday year))
>>> + ((>= startday 4)
>>> + (list 13 startday year))
>>> + )
>>> + )
>>> + ((= quarter 3)
>>> + (setq startday (org-day-of-week 1 7 year))
>>> + (cond
>>> + ((= startday 0)
>>> + (list 26 startday year))
>>> + ((< startday 4)
>>> + (list 27 startday year))
>>> + ((>= startday 4)
>>> + (list 26 startday year))
>>> + )
>>> + )
>>> + ((= quarter 4)
>>> + (setq startday (org-day-of-week 1 10 year))
>>> + (cond
>>> + ((= startday 0)
>>> + (list 39 startday year))
>>> + ((<= startday 4)
>>> + (list 40 startday year))
>>> + ((> startday 4)
>>> + (list 39 startday year))
>>> + )
>>> + )
>>> + )
>>> + )
>>> (defun org-clock-special-range (key &optional time as-strings)
>>> "Return two times bordering a special time range.
>>> @@ -1670,6 +1728,10 @@ the returned times will be formatted
>>> strings."
>>> (dow (nth 6 tm))
>>> (skey (symbol-name key))
>>> (shift 0)
>>> + (q (cond ((>= (nth 4 tm) 10) 4)
>>> + ((>= (nth 4 tm) 7) 3)
>>> + ((>= (nth 4 tm) 4) 2)
>>> + ((>= (nth 4 tm) 1) 1)))
>>> s1 m1 h1 d1 month1 y1 diff ts te fm txt w date)
>>> (cond
>>> ((string-match "^[0-9]+$" skey)
>>> @@ -1687,19 +1749,35 @@ the returned times will be formatted
>>> strings."
>>> (setq d (nth 1 date) month (car date) y (nth 2 date)
>>> dow 1
>>> key 'week))
>>> + ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
>>> + (require 'cal-iso)
>>> + (setq y (string-to-number (match-string 1 skey)))
>>> + (setq q (string-to-number (match-string 2 skey)))
>>> + (setq date (calendar-gregorian-from-absolute
>>> + (calendar-absolute-from-iso (org-quarter-to-
>>> date q y))))
>>> + (setq d (nth 1 date) month (car date) y (nth 2 date)
>>> + dow 1
>>> + key 'quarter))
>>> ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\
>>> \{1,2\\}\\)$" skey)
>>> (setq y (string-to-number (match-string 1 skey))
>>> month (string-to-number (match-string 2 skey))
>>> d (string-to-number (match-string 3 skey))
>>> key 'day))
>>> + ; looking forward with quarters is not implemented yet.
>>> +; ((string-match "\\(\\(?:[-]\\|\\(?:!q\\)[+]\\)[0-9]+\\)$"
>>> skey)
>>> ((string-match "\\([-+][0-9]+\\)$" skey)
>>> (setq shift (string-to-number (match-string 1 skey))
>>> - key (intern (substring skey 0 (match-beginning 1))))))
>>> + key (intern (substring skey 0 (match-beginning 1))))
>>> + (if(and (memq key '(quarter thisq)) (> shift 0))
>>> + (error "Looking forward with quarters isn't implemented.")
>>> + ())))
>>> +
>>> (when (= shift 0)
>>> - (cond ((eq key 'yesterday) (setq key 'today shift -1))
>>> - ((eq key 'lastweek) (setq key 'week shift -1))
>>> - ((eq key 'lastmonth) (setq key 'month shift -1))
>>> - ((eq key 'lastyear) (setq key 'year shift -1))))
>>> + (cond ((eq key 'yesterday) (setq key 'today shift -1))
>>> + ((eq key 'lastweek) (setq key 'week shift -1))
>>> + ((eq key 'lastmonth) (setq key 'month shift -1))
>>> + ((eq key 'lastyear) (setq key 'year shift -1))
>>> + ((eq key 'lastq) (setq key 'quarter shift -1))))
>>> (cond
>>> ((memq key '(day today))
>>> (setq d (+ d shift) h 0 m 0 h1 24 m1 0))
>>> @@ -1708,6 +1786,29 @@ the returned times will be formatted
>>> strings."
>>> m 0 h 0 d (- d diff) d1 (+ 7 d)))
>>> ((memq key '(month thismonth))
>>> (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month)
>>> h1 0 m1 0))
>>> + ((memq key '(quarter thisq))
>>> + ; compute if this shift remains in this year
>>> + ; if not, compute how many years and quarters we have to
>>> shift (via floor*)
>>> + ; and compute the shifted years, months and quarters
>>> + (cond
>>> + ((< (+ (- q 1) shift) 0) ; shift not in this year
>>> + (setq interval (* -1 (+ (- q 1) shift)))
>>> + ; set tmp to ((years to shift) (quarters to shift))
>>> + (setq tmp (floor* interval 4))
>>> + ; due to the use of floor, 0 quarters actually means 4
>>> + (if (= 0 (nth 1 tmp))
>>> + (setq shiftedy (- y (nth 0 tmp))
>>> + shiftedm 1
>>> + shiftedq 1)
>>> + (setq shiftedy (- y (+ 1 (nth 0 tmp)))
>>> + shiftedm (- 13 (* 3 (nth 1 tmp)))
>>> + shiftedq (- 5 (nth 1 tmp))))
>>> + (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3
>>> shiftedm) h1 0 m1 0 y shiftedy))
>>> + ((> (+ q shift) 0) ; shift is whitin this year
>>> + (setq shiftedq (+ q shift))
>>> + (setq shiftedy y)
>>> + (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1)))
>>> month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
>>> +
>>> ((memq key '(year thisyear))
>>> (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
>>> (t (error "No such time block %s" key)))
>>> @@ -1723,10 +1824,19 @@ the returned times will be formatted
>>> strings."
>>> ((memq key '(month thismonth))
>>> (setq txt (format-time-string "%B %Y" ts)))
>>> ((memq key '(year thisyear))
>>> - (setq txt (format-time-string "the year %Y" ts))))
>>> + (setq txt (format-time-string "the year %Y" ts)))
>>> + ((memq key '(quarter thisq))
>>> + (setq txt (concatenate 'string (org-count-quarter shiftedq)
>>> " quarter of " (number-to-string shiftedy))))
>>> + )
>>> (if as-strings
>>> (list (format-time-string fm ts) (format-time-string fm te)
>>> txt)
>>> (list ts te txt))))
>>> +(defun org-count-quarter (n)
>>> + (cond
>>> + ((= n 1) "1st")
>>> + ((= n 2) "2nd")
>>> + ((= n 3) "3rd")
>>> + ((= n 4) "4th")))
>>> (defun org-clocktable-shift (dir n)
>>> "Try to shift the :block date of the clocktable at point.
>>> @@ -1750,17 +1860,19 @@ the currently selected interval size."
>>> ((equal s "yesterday") (setq s "today-1"))
>>> ((equal s "lastweek") (setq s "thisweek-1"))
>>> ((equal s "lastmonth") (setq s "thismonth-1"))
>>> - ((equal s "lastyear") (setq s "thisyear-1")))
>>> + ((equal s "lastyear") (setq s "thisyear-1"))
>>> + ((equal s "lastq") (setq s "thisq-1")))
>>> +
>>> (cond
>>> - ((string-match "^\\(today\\|thisweek\\|thismonth\\|
>>> thisyear\\)\\([-+][0-9]+\\)?$" s)
>>> + ((string-match "^\\(today\\|thisweek\\|thismonth\\|
>>> thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s)
>>> (setq block (match-string 1 s)
>>> shift (if (match-end 2)
>>> (string-to-number (match-string 2 s))
>>> 0))
>>> (setq shift (+ shift n))
>>> (setq ins (if (= shift 0) block (format "%s%+d" block
>>> shift))))
>>> - ((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\
>>> \}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
>>> - ;; 1 1 2 3 3
>>> 4 4 5 6 6 5 2
>>> + ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\
>>> \{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
>>> + ;; 1 1 2 3 3
>>> 4 4 5 6 6 5 2
>>> (setq y (string-to-number (match-string 1 s))
>>> wp (and (match-end 3) (match-string 3 s))
>>> mw (and (match-end 4) (string-to-number (match-string
>>> 4 s)))
>>> @@ -1769,12 +1881,28 @@ the currently selected interval size."
>>> (d (setq ins (format-time-string
>>> "%Y-%m-%d"
>>> (encode-time 0 0 0 (+ d n) m y))))
>>> - ((and wp mw (> (length wp) 0))
>>> + ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
>>> (require 'cal-iso)
>>> (setq date (calendar-gregorian-from-absolute (calendar-
>>> absolute-from-iso (list (+ mw n) 1 y))))
>>> (setq ins (format-time-string
>>> "%G-W%V"
>>> (encode-time 0 0 0 (nth 1 date) (car date)
>>> (nth 2 date)))))
>>> + ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
>>> + (require 'cal-iso)
>>> + ; if the 4th + 1 quarter is requested we flip to the
>>> 1st quarter of the next year
>>> + (if (> (+ mw n) 4)
>>> + (setq mw 0
>>> + y (+ 1 y))
>>> + ())
>>> + ; if the 1st - 1 quarter is requested we flip to the
>>> 4th quarter of the previous year
>>> + (if (= (+ mw n) 0)
>>> + (setq mw 5
>>> + y (- y 1))
>>> + ())
>>> + (setq date (calendar-gregorian-from-absolute (calendar-
>>> absolute-from-iso (org-quarter-to-date (+ mw n) y))))
>>> + (setq ins (format-time-string
>>> + (concatenate 'string (number-to-string y) "-
>>> Q" (number-to-string (+ mw n)))
>>> + (encode-time 0 0 0 (nth 1 date) (car date)
>>> (nth 2 date)))))
>>> (mw
>>> (setq ins (format-time-string
>>> "%Y-%m"
>>>
>>>
>>> _______________________________________________
>>> Emacs-orgmode mailing list
>>> Please use `Reply All' to send replies to the list.
>>> Emacs-orgmode@gnu.org
>>> http://lists.gnu.org/mailman/listinfo/emacs-orgmode
>>
>
- Carsten
^ permalink raw reply [flat|nested] 5+ messages in thread* Re: [PATCH] Quarters added to clocktables
2010-11-29 9:22 ` Erwin Vrolijk
2010-11-29 9:39 ` Carsten Dominik
@ 2010-11-29 10:29 ` Carsten Dominik
1 sibling, 0 replies; 5+ messages in thread
From: Carsten Dominik @ 2010-11-29 10:29 UTC (permalink / raw)
To: Erwin Vrolijk; +Cc: emacs-orgmode
On Nov 29, 2010, at 10:22 AM, Erwin Vrolijk wrote:
> Hi Carsten,
>
> Thank you for your feedback. The FSF papers are no problem, i've
> already got them by mail.
> Here are the new patches, patched to the current HEAD.
Hi Erwin,
I have applied your patches - please make sure that you complete the
FSF copyright assignment process and keep me up to date on how that is
going.
Thanks!
- Carsten
>
> Regards,
> Erwin Vrolijk
> Snow B.V.
>
> diff --git a/doc/org.texi b/doc/org.texi
> index 17d6e65..a4073d0 100644
> --- a/doc/org.texi
> +++ b/doc/org.texi
> @@ -5820,6 +5820,7 @@ be selected:
> 2007-12-31 @r{New year eve 2007}
> 2007-12 @r{December 2007}
> 2007-W50 @r{ISO-week 50 in 2007}
> + 2007-Q2 @r{2nd quarter in 2007}
> 2007 @r{the year 2007}
> today, yesterday, today-@var{N} @r{a relative
> day}
> thisweek, lastweek, thisweek-@var{N} @r{a relative
> week}
>
> diff --git a/lisp/org-clock.el b/lisp/org-clock.el
> index e798027..a7c4a97 100644
> --- a/lisp/org-clock.el
> +++ b/lisp/org-clock.el
> @@ -1654,6 +1654,65 @@ buffer and update it."
> (>= (match-end 0) pos)
> start))))
> +(defun org-day-of-week (day month year)
> + "Returns the day of the week as an integer."
> + (nth 6
> + (decode-time
> + (date-to-time
> + (format "%d-%02d-%02dT00:00:00" year month day)))))
> +
> +(defun org-quarter-to-date (quarter year)
> + "Get the date (week day year) of the first day of a given quarter."
> + (cond
> + ((= quarter 1)
> + (setq startday (org-day-of-week 1 1 year))
> + (cond
> + ((= startday 0)
> + (list 52 7 (- year 1)))
> + ((= startday 6)
> + (list 52 6 (- year 1)))
> + ((<= startday 4)
> + (list 1 startday year))
> + ((> startday 4)
> + (list 53 startday (- year 1)))
> + )
> + )
> + ((= quarter 2)
> + (setq startday (org-day-of-week 1 4 year))
> + (cond
> + ((= startday 0)
> + (list 13 startday year))
> + ((< startday 4)
> + (list 14 startday year))
> + ((>= startday 4)
> + (list 13 startday year))
> + )
> + )
> + ((= quarter 3)
> + (setq startday (org-day-of-week 1 7 year))
> + (cond
> + ((= startday 0)
> + (list 26 startday year))
> + ((< startday 4)
> + (list 27 startday year))
> + ((>= startday 4)
> + (list 26 startday year))
> + )
> + )
> + ((= quarter 4)
> + (setq startday (org-day-of-week 1 10 year))
> + (cond
> + ((= startday 0)
> + (list 39 startday year))
> + ((<= startday 4)
> + (list 40 startday year))
> + ((> startday 4)
> + (list 39 startday year))
> + )
> + )
> + )
> + )
> +
> (defun org-clock-special-range (key &optional time as-strings)
> "Return two times bordering a special time range.
> Key is a symbol specifying the range and can be one of `today',
> `yesterday',
> @@ -1670,6 +1729,10 @@ the returned times will be formatted strings."
> (dow (nth 6 tm))
> (skey (symbol-name key))
> (shift 0)
> + (q (cond ((>= (nth 4 tm) 10) 4)
> + ((>= (nth 4 tm) 7) 3)
> + ((>= (nth 4 tm) 4) 2)
> + ((>= (nth 4 tm) 1) 1)))
> s1 m1 h1 d1 month1 y1 diff ts te fm txt w date)
> (cond
> ((string-match "^[0-9]+$" skey)
> @@ -1687,6 +1750,15 @@ the returned times will be formatted strings."
> (setq d (nth 1 date) month (car date) y (nth 2 date)
> dow 1
> key 'week))
> + ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
> + (require 'cal-iso)
> + (setq y (string-to-number (match-string 1 skey)))
> + (setq q (string-to-number (match-string 2 skey)))
> + (setq date (calendar-gregorian-from-absolute
> + (calendar-absolute-from-iso (org-quarter-to-date
> q y))))
> + (setq d (nth 1 date) month (car date) y (nth 2 date)
> + dow 1
> + key 'quarter))
> ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\
> \{1,2\\}\\)$" skey)
> (setq y (string-to-number (match-string 1 skey))
> month (string-to-number (match-string 2 skey))
> @@ -1694,12 +1766,17 @@ the returned times will be formatted strings."
> key 'day))
> ((string-match "\\([-+][0-9]+\\)$" skey)
> (setq shift (string-to-number (match-string 1 skey))
> - key (intern (substring skey 0 (match-beginning 1))))))
> + key (intern (substring skey 0 (match-beginning 1))))
> + (if(and (memq key '(quarter thisq)) (> shift 0))
> + (error "Looking forward with quarters isn't implemented.")
> + ())))
> +
> (when (= shift 0)
> - (cond ((eq key 'yesterday) (setq key 'today shift -1))
> - ((eq key 'lastweek) (setq key 'week shift -1))
> - ((eq key 'lastmonth) (setq key 'month shift -1))
> - ((eq key 'lastyear) (setq key 'year shift -1))))
> + (cond ((eq key 'yesterday) (setq key 'today shift -1))
> + ((eq key 'lastweek) (setq key 'week shift -1))
> + ((eq key 'lastmonth) (setq key 'month shift -1))
> + ((eq key 'lastyear) (setq key 'year shift -1))
> + ((eq key 'lastq) (setq key 'quarter shift -1))))
> (cond
> ((memq key '(day today))
> (setq d (+ d shift) h 0 m 0 h1 24 m1 0))
> @@ -1708,6 +1785,28 @@ the returned times will be formatted strings."
> m 0 h 0 d (- d diff) d1 (+ 7 d)))
> ((memq key '(month thismonth))
> (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month)
> h1 0 m1 0))
> + ((memq key '(quarter thisq))
> + ; compute if this shift remains in this year
> + ; if not, compute how many years and quarters we have to
> shift (via floor*)
> + ; and compute the shifted years, months and quarters
> + (cond
> + ((< (+ (- q 1) shift) 0) ; shift not in this year
> + (setq interval (* -1 (+ (- q 1) shift)))
> + ; set tmp to ((years to shift) (quarters to shift))
> + (setq tmp (floor* interval 4))
> + ; due to the use of floor, 0 quarters actually means 4
> + (if (= 0 (nth 1 tmp))
> + (setq shiftedy (- y (nth 0 tmp))
> + shiftedm 1
> + shiftedq 1)
> + (setq shiftedy (- y (+ 1 (nth 0 tmp)))
> + shiftedm (- 13 (* 3 (nth 1 tmp)))
> + shiftedq (- 5 (nth 1 tmp))))
> + (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm)
> h1 0 m1 0 y shiftedy))
> + ((> (+ q shift) 0) ; shift is whitin this year
> + (setq shiftedq (+ q shift))
> + (setq shiftedy y)
> + (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1)))
> month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
> ((memq key '(year thisyear))
> (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
> (t (error "No such time block %s" key)))
> @@ -1723,11 +1822,21 @@ the returned times will be formatted strings."
> ((memq key '(month thismonth))
> (setq txt (format-time-string "%B %Y" ts)))
> ((memq key '(year thisyear))
> - (setq txt (format-time-string "the year %Y" ts))))
> + (setq txt (format-time-string "the year %Y" ts)))
> + ((memq key '(quarter thisq))
> + (setq txt (concatenate 'string (org-count-quarter shiftedq) "
> quarter of " (number-to-string shiftedy))))
> + )
> (if as-strings
> (list (format-time-string fm ts) (format-time-string fm te) txt)
> (list ts te txt))))
> +(defun org-count-quarter (n)
> + (cond
> + ((= n 1) "1st")
> + ((= n 2) "2nd")
> + ((= n 3) "3rd")
> + ((= n 4) "4th")))
> +
> (defun org-clocktable-shift (dir n)
> "Try to shift the :block date of the clocktable at point.
> Point must be in the #+BEGIN: line of a clocktable, or this function
> @@ -1750,45 +1859,63 @@ the currently selected interval size."
> ((equal s "yesterday") (setq s "today-1"))
> ((equal s "lastweek") (setq s "thisweek-1"))
> ((equal s "lastmonth") (setq s "thismonth-1"))
> - ((equal s "lastyear") (setq s "thisyear-1")))
> - (cond
> - ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\)\
> \([-+][0-9]+\\)?$" s)
> - (setq block (match-string 1 s)
> - shift (if (match-end 2)
> - (string-to-number (match-string 2 s))
> - 0))
> - (setq shift (+ shift n))
> - (setq ins (if (= shift 0) block (format "%s%+d" block shift))))
> - ((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\\}\\)
> \\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
> - ;; 1 1 2 3 3 4
> 4 5 6 6 5 2
> - (setq y (string-to-number (match-string 1 s))
> - wp (and (match-end 3) (match-string 3 s))
> - mw (and (match-end 4) (string-to-number (match-string 4 s)))
> - d (and (match-end 6) (string-to-number (match-string 6 s))))
> - (cond
> - (d (setq ins (format-time-string
> - "%Y-%m-%d"
> - (encode-time 0 0 0 (+ d n) m y))))
> - ((and wp mw (> (length wp) 0))
> - (require 'cal-iso)
> - (setq date (calendar-gregorian-from-absolute (calendar-
> absolute-from-iso (list (+ mw n) 1 y))))
> - (setq ins (format-time-string
> - "%G-W%V"
> - (encode-time 0 0 0 (nth 1 date) (car date) (nth 2
> date)))))
> - (mw
> - (setq ins (format-time-string
> - "%Y-%m"
> - (encode-time 0 0 0 1 (+ mw n) y))))
> - (y
> - (setq ins (number-to-string (+ y n))))))
> - (t (error "Cannot shift clocktable block")))
> - (when ins
> - (goto-char b)
> - (insert ins)
> - (delete-region (point) (+ (point) (- e b)))
> - (beginning-of-line 1)
> - (org-update-dblock)
> - t)))))
> + ((equal s "lastyear") (setq s "thisyear-1"))
> + ((equal s "lastq") (setq s "thisq-1")))
> +
> + (cond
> + ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\
> \|thisq\\)\\([-+][0-9]+\\)?$" s)
> + (setq block (match-string 1 s)
> + shift (if (match-end 2)
> + (string-to-number (match-string 2 s))
> + 0))
> + (setq shift (+ shift n))
> + (setq ins (if (= shift 0) block (format "%s%+d" block
> shift))))
> + ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\
> \)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
> + ;; 1 1 2 3 3
> 4 4 5 6 6 5 2
> + (setq y (string-to-number (match-string 1 s))
> + wp (and (match-end 3) (match-string 3 s))
> + mw (and (match-end 4) (string-to-number (match-
> string 4 s)))
> + d (and (match-end 6) (string-to-number (match-string 6
> s))))
> + (cond
> + (d (setq ins (format-time-string
> + "%Y-%m-%d"
> + (encode-time 0 0 0 (+ d n) m y))))
> + ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
> + (require 'cal-iso)
> + (setq date (calendar-gregorian-from-absolute (calendar-
> absolute-from-iso (list (+ mw n) 1 y))))
> + (setq ins (format-time-string
> + "%G-W%V"
> + (encode-time 0 0 0 (nth 1 date) (car date)
> (nth 2 date)))))
> + ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
> + (require 'cal-iso)
> + ; if the 4th + 1 quarter is requested we flip to the 1st
> quarter of the next year
> + (if (> (+ mw n) 4)
> + (setq mw 0
> + y (+ 1 y))
> + ())
> + ; if the 1st - 1 quarter is requested we flip to the 4th
> quarter of the previous year
> + (if (= (+ mw n) 0)
> + (setq mw 5
> + y (- y 1))
> + ())
> + (setq date (calendar-gregorian-from-absolute (calendar-
> absolute-from-iso (org-quarter-to-date (+ mw n) y))))
> + (setq ins (format-time-string
> + (concatenate 'string (number-to-string y) "-
> Q" (number-to-string (+ mw n)))
> + (encode-time 0 0 0 (nth 1 date) (car date)
> (nth 2 date)))))
> + (mw
> + (setq ins (format-time-string
> + "%Y-%m"
> + (encode-time 0 0 0 1 (+ mw n) y))))
> + (y
> + (setq ins (number-to-string (+ y n))))))
> + (t (error "Cannot shift clocktable block")))
> + (when ins
> + (goto-char b)
> + (insert ins)
> + (delete-region (point) (+ (point) (- e b)))
> + (beginning-of-line 1)
> + (org-update-dblock)
> + t)))))
> (defun org-dblock-write:clocktable (params)
> "Write the standard clocktable."
>
>
>
> Carsten Dominik wrote:
>> Hi Erwin,
>>
>> this patch looks good. However, it does not apply cleanly to the
>> current head, and I need to ask you to sign the FSF papers for it.
>> Are you willing to do this?
>>
>> Thanks
>>
>> - Carsten
>>
>> On Nov 19, 2010, at 2:00 PM, Erwin Vrolijk wrote:
>>
>>> Hi,
>>>
>>> I'm proud to present my first patch to orgmode.
>>> With this patch quarters are added to clocktables. It is now
>>> possible to show data for a quarter via the following syntax:
>>>
>>> :block thisq[-n] or
>>> :block lastq
>>> :block 2010-Q2
>>>
>>> Other places where quarters might be handy (for instance repeating
>>> events quarterly) are still todo.
>>>
>>> I've patched two files, the main file lisp/org-clock.el and the
>>> documentation in doc/org.texti
>>>
>>> Regards,
>>> Erwin Vrolijk
>>> http://snow.nl
>>>
>>> diff --git a/doc/org.texi b/doc/org.texi
>>> index 06583d7..5f07dbd 100644
>>> --- a/doc/org.texi
>>> +++ b/doc/org.texi
>>> @@ -5820,6 +5820,7 @@ be selected:
>>> 2007-12-31 @r{New year eve 2007}
>>> 2007-12 @r{December 2007}
>>> 2007-W50 @r{ISO-week 50 in 2007}
>>> + 2007-Q2 @r{2nd quarter in 2007}
>>> 2007 @r{the year 2007}
>>> today, yesterday, today-@var{N} @r{a relative
>>> day}
>>> thisweek, lastweek, thisweek-@var{N} @r{a relative
>>> week}
>>>
>>>
>>> diff --git a/lisp/org-clock.el b/lisp/org-clock.el
>>> index 3146926..1301fb8 100644
>>> --- a/lisp/org-clock.el
>>> +++ b/lisp/org-clock.el
>>> @@ -1653,6 +1653,64 @@ buffer and update it."
>>> (re-search-forward "^[ \t]+#\\+END:.*" nil t)
>>> (>= (match-end 0) pos)
>>> start))))
>>> +(defun org-day-of-week (day month year)
>>> + "Returns the day of the week as an integer."
>>> + (nth 6
>>> + (decode-time
>>> + (date-to-time
>>> + (format "%d-%02d-%02dT00:00:00" year month day)))))
>>> +
>>> +(defun org-quarter-to-date (quarter year)
>>> + "Get the date (week day year) of the first day of a given
>>> quarter."
>>> + (cond
>>> + ((= quarter 1)
>>> + (setq startday (org-day-of-week 1 1 year))
>>> + (cond
>>> + ((= startday 0)
>>> + (list 52 7 (- year 1)))
>>> + ((= startday 6)
>>> + (list 52 6 (- year 1)))
>>> + ((<= startday 4)
>>> + (list 1 startday year))
>>> + ((> startday 4)
>>> + (list 53 startday (- year 1)))
>>> + )
>>> + )
>>> + ((= quarter 2)
>>> + (setq startday (org-day-of-week 1 4 year))
>>> + (cond
>>> + ((= startday 0)
>>> + (list 13 startday year))
>>> + ((< startday 4)
>>> + (list 14 startday year))
>>> + ((>= startday 4)
>>> + (list 13 startday year))
>>> + )
>>> + )
>>> + ((= quarter 3)
>>> + (setq startday (org-day-of-week 1 7 year))
>>> + (cond
>>> + ((= startday 0)
>>> + (list 26 startday year))
>>> + ((< startday 4)
>>> + (list 27 startday year))
>>> + ((>= startday 4)
>>> + (list 26 startday year))
>>> + )
>>> + )
>>> + ((= quarter 4)
>>> + (setq startday (org-day-of-week 1 10 year))
>>> + (cond
>>> + ((= startday 0)
>>> + (list 39 startday year))
>>> + ((<= startday 4)
>>> + (list 40 startday year))
>>> + ((> startday 4)
>>> + (list 39 startday year))
>>> + )
>>> + )
>>> + )
>>> + )
>>> (defun org-clock-special-range (key &optional time as-strings)
>>> "Return two times bordering a special time range.
>>> @@ -1670,6 +1728,10 @@ the returned times will be formatted
>>> strings."
>>> (dow (nth 6 tm))
>>> (skey (symbol-name key))
>>> (shift 0)
>>> + (q (cond ((>= (nth 4 tm) 10) 4)
>>> + ((>= (nth 4 tm) 7) 3)
>>> + ((>= (nth 4 tm) 4) 2)
>>> + ((>= (nth 4 tm) 1) 1)))
>>> s1 m1 h1 d1 month1 y1 diff ts te fm txt w date)
>>> (cond
>>> ((string-match "^[0-9]+$" skey)
>>> @@ -1687,19 +1749,35 @@ the returned times will be formatted
>>> strings."
>>> (setq d (nth 1 date) month (car date) y (nth 2 date)
>>> dow 1
>>> key 'week))
>>> + ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
>>> + (require 'cal-iso)
>>> + (setq y (string-to-number (match-string 1 skey)))
>>> + (setq q (string-to-number (match-string 2 skey)))
>>> + (setq date (calendar-gregorian-from-absolute
>>> + (calendar-absolute-from-iso (org-quarter-to-
>>> date q y))))
>>> + (setq d (nth 1 date) month (car date) y (nth 2 date)
>>> + dow 1
>>> + key 'quarter))
>>> ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\
>>> \{1,2\\}\\)$" skey)
>>> (setq y (string-to-number (match-string 1 skey))
>>> month (string-to-number (match-string 2 skey))
>>> d (string-to-number (match-string 3 skey))
>>> key 'day))
>>> + ; looking forward with quarters is not implemented yet.
>>> +; ((string-match "\\(\\(?:[-]\\|\\(?:!q\\)[+]\\)[0-9]+\\)$"
>>> skey)
>>> ((string-match "\\([-+][0-9]+\\)$" skey)
>>> (setq shift (string-to-number (match-string 1 skey))
>>> - key (intern (substring skey 0 (match-beginning 1))))))
>>> + key (intern (substring skey 0 (match-beginning 1))))
>>> + (if(and (memq key '(quarter thisq)) (> shift 0))
>>> + (error "Looking forward with quarters isn't implemented.")
>>> + ())))
>>> +
>>> (when (= shift 0)
>>> - (cond ((eq key 'yesterday) (setq key 'today shift -1))
>>> - ((eq key 'lastweek) (setq key 'week shift -1))
>>> - ((eq key 'lastmonth) (setq key 'month shift -1))
>>> - ((eq key 'lastyear) (setq key 'year shift -1))))
>>> + (cond ((eq key 'yesterday) (setq key 'today shift -1))
>>> + ((eq key 'lastweek) (setq key 'week shift -1))
>>> + ((eq key 'lastmonth) (setq key 'month shift -1))
>>> + ((eq key 'lastyear) (setq key 'year shift -1))
>>> + ((eq key 'lastq) (setq key 'quarter shift -1))))
>>> (cond
>>> ((memq key '(day today))
>>> (setq d (+ d shift) h 0 m 0 h1 24 m1 0))
>>> @@ -1708,6 +1786,29 @@ the returned times will be formatted
>>> strings."
>>> m 0 h 0 d (- d diff) d1 (+ 7 d)))
>>> ((memq key '(month thismonth))
>>> (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month)
>>> h1 0 m1 0))
>>> + ((memq key '(quarter thisq))
>>> + ; compute if this shift remains in this year
>>> + ; if not, compute how many years and quarters we have to
>>> shift (via floor*)
>>> + ; and compute the shifted years, months and quarters
>>> + (cond
>>> + ((< (+ (- q 1) shift) 0) ; shift not in this year
>>> + (setq interval (* -1 (+ (- q 1) shift)))
>>> + ; set tmp to ((years to shift) (quarters to shift))
>>> + (setq tmp (floor* interval 4))
>>> + ; due to the use of floor, 0 quarters actually means 4
>>> + (if (= 0 (nth 1 tmp))
>>> + (setq shiftedy (- y (nth 0 tmp))
>>> + shiftedm 1
>>> + shiftedq 1)
>>> + (setq shiftedy (- y (+ 1 (nth 0 tmp)))
>>> + shiftedm (- 13 (* 3 (nth 1 tmp)))
>>> + shiftedq (- 5 (nth 1 tmp))))
>>> + (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3
>>> shiftedm) h1 0 m1 0 y shiftedy))
>>> + ((> (+ q shift) 0) ; shift is whitin this year
>>> + (setq shiftedq (+ q shift))
>>> + (setq shiftedy y)
>>> + (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1)))
>>> month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
>>> +
>>> ((memq key '(year thisyear))
>>> (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
>>> (t (error "No such time block %s" key)))
>>> @@ -1723,10 +1824,19 @@ the returned times will be formatted
>>> strings."
>>> ((memq key '(month thismonth))
>>> (setq txt (format-time-string "%B %Y" ts)))
>>> ((memq key '(year thisyear))
>>> - (setq txt (format-time-string "the year %Y" ts))))
>>> + (setq txt (format-time-string "the year %Y" ts)))
>>> + ((memq key '(quarter thisq))
>>> + (setq txt (concatenate 'string (org-count-quarter shiftedq)
>>> " quarter of " (number-to-string shiftedy))))
>>> + )
>>> (if as-strings
>>> (list (format-time-string fm ts) (format-time-string fm te)
>>> txt)
>>> (list ts te txt))))
>>> +(defun org-count-quarter (n)
>>> + (cond
>>> + ((= n 1) "1st")
>>> + ((= n 2) "2nd")
>>> + ((= n 3) "3rd")
>>> + ((= n 4) "4th")))
>>> (defun org-clocktable-shift (dir n)
>>> "Try to shift the :block date of the clocktable at point.
>>> @@ -1750,17 +1860,19 @@ the currently selected interval size."
>>> ((equal s "yesterday") (setq s "today-1"))
>>> ((equal s "lastweek") (setq s "thisweek-1"))
>>> ((equal s "lastmonth") (setq s "thismonth-1"))
>>> - ((equal s "lastyear") (setq s "thisyear-1")))
>>> + ((equal s "lastyear") (setq s "thisyear-1"))
>>> + ((equal s "lastq") (setq s "thisq-1")))
>>> +
>>> (cond
>>> - ((string-match "^\\(today\\|thisweek\\|thismonth\\|
>>> thisyear\\)\\([-+][0-9]+\\)?$" s)
>>> + ((string-match "^\\(today\\|thisweek\\|thismonth\\|
>>> thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s)
>>> (setq block (match-string 1 s)
>>> shift (if (match-end 2)
>>> (string-to-number (match-string 2 s))
>>> 0))
>>> (setq shift (+ shift n))
>>> (setq ins (if (= shift 0) block (format "%s%+d" block
>>> shift))))
>>> - ((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\
>>> \}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
>>> - ;; 1 1 2 3 3
>>> 4 4 5 6 6 5 2
>>> + ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\
>>> \{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
>>> + ;; 1 1 2 3 3
>>> 4 4 5 6 6 5 2
>>> (setq y (string-to-number (match-string 1 s))
>>> wp (and (match-end 3) (match-string 3 s))
>>> mw (and (match-end 4) (string-to-number (match-string
>>> 4 s)))
>>> @@ -1769,12 +1881,28 @@ the currently selected interval size."
>>> (d (setq ins (format-time-string
>>> "%Y-%m-%d"
>>> (encode-time 0 0 0 (+ d n) m y))))
>>> - ((and wp mw (> (length wp) 0))
>>> + ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
>>> (require 'cal-iso)
>>> (setq date (calendar-gregorian-from-absolute (calendar-
>>> absolute-from-iso (list (+ mw n) 1 y))))
>>> (setq ins (format-time-string
>>> "%G-W%V"
>>> (encode-time 0 0 0 (nth 1 date) (car date)
>>> (nth 2 date)))))
>>> + ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
>>> + (require 'cal-iso)
>>> + ; if the 4th + 1 quarter is requested we flip to the
>>> 1st quarter of the next year
>>> + (if (> (+ mw n) 4)
>>> + (setq mw 0
>>> + y (+ 1 y))
>>> + ())
>>> + ; if the 1st - 1 quarter is requested we flip to the
>>> 4th quarter of the previous year
>>> + (if (= (+ mw n) 0)
>>> + (setq mw 5
>>> + y (- y 1))
>>> + ())
>>> + (setq date (calendar-gregorian-from-absolute (calendar-
>>> absolute-from-iso (org-quarter-to-date (+ mw n) y))))
>>> + (setq ins (format-time-string
>>> + (concatenate 'string (number-to-string y) "-
>>> Q" (number-to-string (+ mw n)))
>>> + (encode-time 0 0 0 (nth 1 date) (car date)
>>> (nth 2 date)))))
>>> (mw
>>> (setq ins (format-time-string
>>> "%Y-%m"
>>>
>>>
>>> _______________________________________________
>>> Emacs-orgmode mailing list
>>> Please use `Reply All' to send replies to the list.
>>> Emacs-orgmode@gnu.org
>>> http://lists.gnu.org/mailman/listinfo/emacs-orgmode
>>
>
- Carsten
^ permalink raw reply [flat|nested] 5+ messages in thread