diff --git a/lisp/org-archive.el b/lisp/org-archive.el index 3214d0994..8fc60c55d 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -160,20 +160,18 @@ archive file is." (defun org-all-archive-files () "Get a list of all archive files used in the current buffer." - (let ((case-fold-search t) - files) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)" - nil t) - (when (save-match-data - (if (eq (match-string 1) ":") (org-at-property-p) - (eq (org-element-type (org-element-at-point)) 'keyword))) - (let ((file (org-extract-archive-file - (match-string-no-properties 2)))) - (when (and (org-string-nw-p file) (file-exists-p file)) - (push file files)))))) + (let (files) + (org-with-point-at 1 + (let ((regexp "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)") + (case-fold-search t)) + (while (re-search-forward regexp nil t) + (when (save-match-data + (if (equal ":" (match-string 1)) (org-at-property-p) + (eq 'keyword (org-element-type (org-element-at-point))))) + (let ((file (org-extract-archive-file + (match-string-no-properties 2)))) + (when (and (org-string-nw-p file) (file-exists-p file)) + (push file files))))))) (setq files (nreverse files)) (let ((file (org-extract-archive-file))) (when (and (org-string-nw-p file) (file-exists-p file)) diff --git a/lisp/org-attach.el b/lisp/org-attach.el index 53389f782..e827d3721 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -193,7 +193,7 @@ D Delete all of a task's attachments. A safer way is s Set a specific attachment directory for this entry or reset to default. i Make children of the current entry inherit its attachment directory."))) (org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) - (message "Select command: [acmlzoOfFdD]") + (message "Select command: [acmlyunzoOfFdD]") (setq c (read-char-exclusive)) (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*")))) (cond diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 420fdadfe..6292a259f 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -2681,6 +2681,15 @@ LEVEL is an integer. Indent by two spaces per level above 1." (if (= level 1) "" (concat "\\_" (make-string (* 2 (1- level)) ?\s)))) +(defun org-clocktable-increment-day (ts &optional n) + "Increment day in TS by N (defaulting to 1). +The TS argument has the same type as the return values of +`float-time' or `current-time'." + (let ((tsd (decode-time ts))) + (cl-incf (nth 3 tsd) (or n 1)) + (setf (nth 8 tsd) nil) ; no time zone: increasing day skips one whole day + (apply 'encode-time tsd))) + (defun org-clocktable-steps (params) "Step through the range to make a number of clock tables." (let* ((ts (plist-get params :tstart)) @@ -2688,7 +2697,6 @@ LEVEL is an integer. Indent by two spaces per level above 1." (ws (plist-get params :wstart)) (ms (plist-get params :mstart)) (step0 (plist-get params :step)) - (step (cdr (assq step0 '((day . 86400) (week . 604800))))) (stepskip0 (plist-get params :stepskip0)) (block (plist-get params :block)) cc tsb) @@ -2715,16 +2723,19 @@ LEVEL is an integer. Indent by two spaces per level above 1." (if (eq step0 'week) (let ((dow (nth 6 (decode-time (seconds-to-time ts))))) (if (<= dow ws) ts - (- ts (* 86400 (- dow ws))))) + (org-clocktable-increment-day ts ; decrement + (- ws dow)))) ts)) (while (< tsb te) (unless (bolp) (insert "\n")) - (let ((start-time (seconds-to-time (max tsb ts)))) - (cl-incf tsb (let ((dow (nth 6 (decode-time (seconds-to-time tsb))))) - (if (or (eq step0 'day) - (= dow ws)) - step - (* 86400 (- ws dow))))) + (let* ((start-time (seconds-to-time (max tsb ts))) + (dow (nth 6 (decode-time (seconds-to-time tsb)))) + (days-to-skip (cond ((eq step0 'day) 1) + ;; else 'week: + ((= dow ws) 7) + (t (- ws dow))))) + (setq tsb (time-to-seconds (org-clocktable-increment-day tsb + days-to-skip))) (insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ") diff --git a/lisp/org.el b/lisp/org.el index c0eaecdab..dce66fc78 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17500,7 +17500,7 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." h (string-to-number (match-string 2 s))) (if (org-pos-in-match-range pos 2) (setq h (+ h n)) - (setq n (* dm (with-no-warnings (signum n)))) + (setq n (* dm (with-no-warnings (cl-signum n)))) (unless (= 0 (setq rem (% m dm))) (setq m (+ m (if (> n 0) (- rem) (- dm rem))))) (setq m (+ m n))) @@ -22977,7 +22977,8 @@ interactive command with similar behavior." (end-of-line) (null (re-search-backward org-outline-regexp-bol nil t))))) -(defun org-at-heading-p (&optional ignored) +(defun org-at-heading-p (&optional _) + "Non-nil when on a headline." (outline-on-heading-p t)) (defun org-in-commented-heading-p (&optional no-inheritance) diff --git a/testing/lisp/test-org-clock.el b/testing/lisp/test-org-clock.el index abb3637bd..ddc135669 100644 --- a/testing/lisp/test-org-clock.el +++ b/testing/lisp/test-org-clock.el @@ -977,7 +977,26 @@ CLOCK: [2017-12-27 Wed 08:00]--[2017-12-27 Wed 16:00] => 8:00" (let ((system-time-locale "en_US")) (test-org-clock-clocktable-contents (concat ":step day :tstart \"<2017-12-25 Mon>\" " - ":tend \"<2017-12-27 Wed 23:59>\" :stepskip0 t"))))))) + ":tend \"<2017-12-27 Wed 23:59>\" :stepskip0 t")))))) + ;; Regression test: Respect DST + (should + (equal " +Daily report: [2018-10-29 Mon] +| Headline | Time | +|--------------+--------| +| *Total time* | *8:00* | +|--------------+--------| +| Foo | 8:00 | +" + (org-test-with-temp-text + "* Foo +CLOCK: [2018-10-29 Mon 08:00]--[2018-10-29 Mon 16:00] => 8:00" + (let ((system-time-locale "en_US")) + (test-org-clock-clocktable-contents + (concat ":step day " + ":stepskip0 t " + ":tstart \"2018-10-01\" " + ":tend \"2018-11-01\""))))))) (ert-deftest test-org-clock/clocktable/extend-today-until () "Test assignment of clock time to days in presence of \"org-extend-today-until\"."