emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Carsten Dominik <carsten.dominik@gmail.com>
To: Erwin Vrolijk <e.vrolijk@snow.nl>
Cc: emacs-orgmode@gnu.org
Subject: Re: [PATCH] Quarters added to clocktables
Date: Mon, 29 Nov 2010 10:39:14 +0100	[thread overview]
Message-ID: <9A26DF39-DED1-4838-96BE-768A91BC830F@gmail.com> (raw)
In-Reply-To: <4CF370ED.6060607@snow.nl>

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

  reply	other threads:[~2010-11-29  9:39 UTC|newest]

Thread overview: 5+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2010-11-19 13:00 [PATCH] Quarters added to clocktables Erwin Vrolijk
2010-11-27  7:09 ` Carsten Dominik
2010-11-29  9:22   ` Erwin Vrolijk
2010-11-29  9:39     ` Carsten Dominik [this message]
2010-11-29 10:29     ` Carsten Dominik

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=9A26DF39-DED1-4838-96BE-768A91BC830F@gmail.com \
    --to=carsten.dominik@gmail.com \
    --cc=e.vrolijk@snow.nl \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).