From: Sebastien Vauban <sva-news-D0wtAvR13HarG/iDocfnWg@public.gmane.org>
To: Org Mode List <emacs-orgmode-mXXj517/zsQ@public.gmane.org>
Subject: Re: [BUG] org-clock-display is partial (only some entries are counted)
Date: Thu, 25 Jun 2015 16:01:59 +0200 [thread overview]
Message-ID: <86egkzj38o.fsf@example.com> (raw)
In-Reply-To: <87pp943m17.fsf-Gpy5sJQTEQHwkn9pgDnJRVAUjnlXr6A1@public.gmane.org> (Nicolas Goaziou's message of "Fri, 20 Feb 2015 11:38:44 +0100")
Hello Nicolas,
Nicolas Goaziou writes:
> Sebastien Vauban writes:
>
>> I still consider the default behavior as dangerous -- because the novice
>> is not aware (except if obvious) that some clock times may be dropped in
>> the computation, and I find that scary --, but thanks anyway for the
>> workaround.
>
> Would you mind testing the following patch, then? `untilnow' is just
> a suggestion.
Applied the patch:
--8<---------------cut here---------------start------------->8---
patching file lisp/org-clock.el
Hunk #1 succeeded at 441 (offset 1 line).
Hunk #2 succeeded at 2091 (offset 3 lines).
Hunk #3 succeeded at 2200 (offset 3 lines).
Hunk #4 succeeded at 2216 (offset 3 lines).
--8<---------------cut here---------------end--------------->8---
Tested on one of my real files, with:
┌────
│ org-clock-display-default-range is a variable defined in `org-clock.el'.
│ Its value is untilnow
│ Original value was thisyear
│
│ Documentation:
│ Default range when displaying clocks with `org-clock-display'.
│
│ You can customize this variable.
└────
Got this:
--8<---------------cut here---------------start------------->8---
Debugger entered--Lisp error: (error "Specified time is not representable")
encode-time(0 0 0 1 1 1)
(setq ts (encode-time s m h d month y) te (encode-time (or s1 s) (or m1 m) (or h1 h) (or d1 d) (or month1 month) (or y1 y)))
(let* ((tm (decode-time (or time (current-time)))) (s 0) (m (nth 1 tm)) (h (nth 2 tm)) (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm)) (dow (nth 6 tm)) (ws (or wstart 1)) (ms (or mstart 1)) (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 interval tmp shiftedy shiftedm shiftedq) (cond ((string-match "^[0-9]+$" skey) (setq y (string-to-number skey) m 1 d 1 key (quote year))) ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)$" skey) (setq y (string-to-number (match-string 1 skey)) month (string-to-number (match-string 2 skey)) d 1 key (quote month))) ((string-match "^\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)$" skey) (require (quote cal-iso)) (setq y (string-to-number (match-string 1 skey)) w (string-to-number (match-string 2 skey))) (setq date (calendar-gregorian-from-absolute (calendar-iso-to-absolute (list w 1 y)))) (setq d (nth 1 date) month (car date) y (nth 2 date) dow 1 key (quote week))) ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey) (require (quote 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-iso-to-absolute (org-quarter-to-date q y)))) (setq d (nth 1 date) month (car date) y (nth 2 date) dow 1 key (quote 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 (quote day))) ((string-match "\\([-+][0-9]+\\)$" skey) (setq shift (string-to-number (match-string 1 skey)) key (intern (substring skey 0 (match-beginning 1)))) (if (and (memq key (quote (quarter thisq))) (> shift 0)) (error "Looking forward with quarters isn't implemented")))) (if (= shift 0) (progn (cond ((eq key (quote yesterday)) (setq key (quote today) shift -1)) ((eq key (quote lastweek)) (setq key (quote week) shift -1)) ((eq key (quote lastmonth)) (setq key (quote month) shift -1)) ((eq key (quote lastyear)) (setq key (quote year) shift -1)) ((eq key (quote lastq)) (setq key (quote quarter) shift -1))))) (cond ((memq key (quote (day today))) (setq d (+ d shift) h 0 m 0 h1 24 m1 0)) ((memq key (quote (week thisweek))) (setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))) m 0 h 0 d (- d diff) d1 (+ 7 d))) ((memq key (quote (month thismonth))) (setq d (or ms 1) h 0 m 0 d1 (or ms 1) month (+ month shift) month1 (1+ month) h1 0 m1 0)) ((memq key (quote (quarter thisq))) (cond ((< (+ (- q 1) shift) 0) (setq interval (* -1 (+ ... shift))) (setq tmp (org-floor* interval 4)) (if (= 0 (nth 1 tmp)) (setq shiftedy (- y ...) shiftedm 1 shiftedq 1) (setq shiftedy (- y ...) shiftedm (- 13 ...) shiftedq (- 5 ...))) (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy)) ((> (+ q shift) 0) (setq shiftedq (+ q shift)) (setq shiftedy y) (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 ...)) month1 (+ 4 (* 3 ...)) h1 0 m1 0)))) ((memq key (quote (year thisyear))) (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) ((eq key (quote untilnow)) (setq y1 y month1 m d1 d m 0 h 0 d 1 month 1 y 1)) ((eq key (quote interactive)) nil) (t (user-error "No such time block %s" key))) (setq ts (encode-time s m h d month y) te (encode-time (or s1 s) (or m1 m) (or h1 h) (or d1 d) (or month1 month) (or y1 y))) (setq fm (cdr org-time-stamp-formats)) (cond ((memq key (quote (day today))) (setq txt (format-time-string "%A, %B %d, %Y" ts))) ((memq key (quote (week thisweek))) (setq txt (format-time-string "week %G-W%V" ts))) ((memq key (quote (month thismonth))) (setq txt (format-time-string "%B %Y" ts))) ((memq key (quote (year thisyear))) (setq txt (format-time-string "the year %Y" ts))) ((eq key (quote untilnow)) (setq txt "now")) ((memq key (quote (quarter thisq))) (setq txt (concat (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) (if (eq key (quote interactive)) (list (org-read-date nil t nil "Range start? ") (org-read-date nil t nil "Range end? ") "(Range interactively set)") (list ts te txt))))
org-clock-special-range(untilnow)
(and (symbolp range) (org-clock-special-range range))
(or (and (symbolp range) (org-clock-special-range range)) (org-clock-special-range (intern (completing-read "Range: " (quote ("today" "yesterday" "thisweek" "lastweek" "thismonth" "lastmonth" "thisyear" "lastyear" "interactive")) nil t))))
(let ((r (or (and (symbolp range) (org-clock-special-range range)) (org-clock-special-range (intern (completing-read "Range: " (quote ...) nil t)))))) (org-clock-sum (car r) (cadr r) headline-filter (or propname :org-clock-minutes-custom)))
org-clock-sum-custom(nil untilnow :org-clock-minutes-default)
(cond ((not arg) (org-clock-sum-custom nil org-clock-display-default-range prop)) (todayp (org-clock-sum-today)) (customp (org-clock-sum-custom nil arg)) (t (org-clock-sum)))
(let* ((todayp (equal arg (quote (4)))) (customp (member arg (quote ((16) today yesterday thisweek lastweek thismonth lastmonth thisyear lastyear interactive)))) (prop (cond ((not arg) :org-clock-minutes-default) (todayp :org-clock-minutes-today) (customp :org-clock-minutes-custom) (t :org-clock-minutes))) time h m p) (cond ((not arg) (org-clock-sum-custom nil org-clock-display-default-range prop)) (todayp (org-clock-sum-today)) (customp (org-clock-sum-custom nil arg)) (t (org-clock-sum))) (if (eq arg (quote (64))) nil (save-excursion (goto-char (point-min)) (while (or (and (equal (setq p ...) (point-min)) (get-text-property p prop)) (setq p (next-single-property-change (point) prop))) (goto-char p) (if (setq time (get-text-property p prop)) (progn (org-clock-put-overlay time)))) (setq h (/ org-clock-file-total-minutes 60) m (- org-clock-file-total-minutes (* 60 h))) (if org-remove-highlights-with-change (progn (org-add-hook (quote before-change-functions) (quote org-clock-remove-overlays) nil (quote local)))))) (message (concat (format "Total file time%s: " (cond (todayp " for today") (customp " (custom)") (t ""))) (org-minutes-to-clocksum-string org-clock-file-total-minutes) " (%d hours and %d minutes)") h m))
org-clock-display(nil)
call-interactively(org-clock-display nil nil)
#[1025 "\306\211?\205\f \211\306\x049\203!\x04\307N\203!\v\203!\310\303!\202\235\x04\311!\262\211\211\242\312=\262\203<\313\x06\a\"\211\262\204\"\314!\203l\x04\203e\315\x03E\fB\r\247\203e\r\316V\203e\r\f\233\211:\203d\211\306\241\210\210\315\x03\"\202\233\317\x06\x06\x06#\x069\203\233\x06\320N\203\233\x06\321N\204\233\322\a\321\323#\210\324\325\326 \211\320N\327#\"\210\262\207" [debug-on-next-call prefix-arg current-prefix-arg disabled-command-function command-history history-length nil disabled run-hooks indirect-function autoload autoload-do-load arrayp execute-kbd-macro 0 call-interactively byte-obsolete-info command-execute-obsolete-warned put t message "%s" macroexp--obsolete-warning "command"] 13 1990350](org-clock-display nil nil nil)
funcall(#[1025 "\306\211?\205\f \211\306\x049\203!\x04\307N\203!\v\203!\310\303!\202\235\x04\311!\262\211\211\242\312=\262\203<\313\x06\a\"\211\262\204\"\314!\203l\x04\203e\315\x03E\fB\r\247\203e\r\316V\203e\r\f\233\211:\203d\211\306\241\210\210\315\x03\"\202\233\317\x06\x06\x06#\x069\203\233\x06\320N\203\233\x06\321N\204\233\322\a\321\323#\210\324\325\326 \211\320N\327#\"\210\262\207" [debug-on-next-call prefix-arg current-prefix-arg disabled-command-function command-history history-length nil disabled run-hooks indirect-function autoload autoload-do-load arrayp execute-kbd-macro 0 call-interactively byte-obsolete-info command-execute-obsolete-warned put t message "%s" macroexp--obsolete-warning "command"] 13 1990350] org-clock-display nil nil nil)
(with-no-warnings (funcall ad--addoit-function cmd record-flag keys special))
(setq ad-return-value (with-no-warnings (funcall ad--addoit-function cmd record-flag keys special)))
(let (ad-return-value) (setq ad-return-value (with-no-warnings (funcall ad--addoit-function cmd record-flag keys special))) (when (fancy-narrow-active-p) (fancy-narrow--motion-function)) ad-return-value)
ad-Advice-command-execute(#[1025 "\306\211?\205\f \211\306\x049\203!\x04\307N\203!\v\203!\310\303!\202\235\x04\311!\262\211\211\242\312=\262\203<\313\x06\a\"\211\262\204\"\314!\203l\x04\203e\315\x03E\fB\r\247\203e\r\316V\203e\r\f\233\211:\203d\211\306\241\210\210\315\x03\"\202\233\317\x06\x06\x06#\x069\203\233\x06\320N\203\233\x06\321N\204\233\322\a\321\323#\210\324\325\326 \211\320N\327#\"\210\262\207" [debug-on-next-call prefix-arg current-prefix-arg disabled-command-function command-history history-length nil disabled run-hooks indirect-function autoload autoload-do-load arrayp execute-kbd-macro 0 call-interactively byte-obsolete-info command-execute-obsolete-warned put t message "%s" macroexp--obsolete-warning "command"] 13 1990350] org-clock-display)
apply(ad-Advice-command-execute #[1025 "\306\211?\205\f \211\306\x049\203!\x04\307N\203!\v\203!\310\303!\202\235\x04\311!\262\211\211\242\312=\262\203<\313\x06\a\"\211\262\204\"\314!\203l\x04\203e\315\x03E\fB\r\247\203e\r\316V\203e\r\f\233\211:\203d\211\306\241\210\210\315\x03\"\202\233\317\x06\x06\x06#\x069\203\233\x06\320N\203\233\x06\321N\204\233\322\a\321\323#\210\324\325\326 \211\320N\327#\"\210\262\207" [debug-on-next-call prefix-arg current-prefix-arg disabled-command-function command-history history-length nil disabled run-hooks indirect-function autoload autoload-do-load arrayp execute-kbd-macro 0 call-interactively byte-obsolete-info command-execute-obsolete-warned put t message "%s" macroexp--obsolete-warning "command"] 13 1990350] org-clock-display)
command-execute(org-clock-display)
--8<---------------cut here---------------end--------------->8---
while the default version `thisyear' did work, before applying the patch.
BTW, `untilnow' is not proposed when TAB'ing on `C-u C-u C-c C-x C-d'.
Best regards,
Seb
--
Sebastien Vauban
next prev parent reply other threads:[~2015-06-25 14:01 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2015-02-17 9:12 [BUG] org-clock-display is partial (only some entries are counted) Sebastien Vauban
2015-02-17 21:13 ` Nicolas Goaziou
[not found] ` <87h9ukutpy.fsf-Gpy5sJQTEQHwkn9pgDnJRVAUjnlXr6A1@public.gmane.org>
2015-02-18 12:20 ` Sebastien Vauban
2015-02-18 14:52 ` Nicolas Goaziou
2015-02-18 15:09 ` Sebastien Vauban
2015-02-20 10:38 ` Nicolas Goaziou
[not found] ` <87pp943m17.fsf-Gpy5sJQTEQHwkn9pgDnJRVAUjnlXr6A1@public.gmane.org>
2015-06-25 14:01 ` Sebastien Vauban [this message]
2015-06-25 16:27 ` Nicolas Goaziou
[not found] ` <87381fycrh.fsf-Gpy5sJQTEQHwkn9pgDnJRVAUjnlXr6A1@public.gmane.org>
2015-07-03 10:13 ` Sebastien Vauban
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=86egkzj38o.fsf@example.com \
--to=sva-news-d0wtavr13harg/idocfnwg@public.gmane.org \
--cc=emacs-orgmode-mXXj517/zsQ@public.gmane.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).