From mboxrd@z Thu Jan 1 00:00:00 1970 From: Carsten Dominik Subject: Re: [PATCH] Quarters added to clocktables Date: Sat, 27 Nov 2010 08:09:40 +0100 Message-ID: <25E3FB69-CAAB-42C0-8115-84ED4E009049@gmail.com> References: <4CE674E5.3080204@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=43150 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PMEuu-0000n8-VW for emacs-orgmode@gnu.org; Sat, 27 Nov 2010 02:09:58 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PMEun-0005g1-FQ for emacs-orgmode@gnu.org; Sat, 27 Nov 2010 02:09:52 -0500 Received: from mail-ew0-f41.google.com ([209.85.215.41]:64875) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PMEun-0005ft-69 for emacs-orgmode@gnu.org; Sat, 27 Nov 2010 02:09:45 -0500 Received: by ewy27 with SMTP id 27so14642188ewy.0 for ; Fri, 26 Nov 2010 23:09:44 -0800 (PST) In-Reply-To: <4CE674E5.3080204@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, 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