From mboxrd@z Thu Jan 1 00:00:00 1970 From: Carsten Dominik Subject: Re: [PATCH] Quarters added to clocktables Date: Mon, 29 Nov 2010 10:39:14 +0100 Message-ID: <9A26DF39-DED1-4838-96BE-768A91BC830F@gmail.com> References: <4CE674E5.3080204@snow.nl> <25E3FB69-CAAB-42C0-8115-84ED4E009049@gmail.com> <4CF370ED.6060607@snow.nl> Mime-Version: 1.0 (Apple Message framework v936) Content-Type: text/plain; charset=US-ASCII; format=flowed; delsp=yes Content-Transfer-Encoding: 7bit Return-path: Received: from [140.186.70.92] (port=58688 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PN0Cr-0005s2-M9 for emacs-orgmode@gnu.org; Mon, 29 Nov 2010 04:39:49 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PN0Cd-00032G-MW for emacs-orgmode@gnu.org; Mon, 29 Nov 2010 04:39:33 -0500 Received: from mail-ey0-f169.google.com ([209.85.215.169]:51369) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PN0Cd-000319-Ac for emacs-orgmode@gnu.org; Mon, 29 Nov 2010 04:39:19 -0500 Received: by eydd26 with SMTP id d26so15371233eyd.0 for ; Mon, 29 Nov 2010 01:39:17 -0800 (PST) In-Reply-To: <4CF370ED.6060607@snow.nl> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Erwin Vrolijk Cc: emacs-orgmode@gnu.org 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