Browse Source

Merge branch 'master' of code.orgmode.org:bzg/org-mode

Bastien 2 years ago
parent
commit
9cb0470723
5 changed files with 55 additions and 26 deletions
  1. 12 14
      lisp/org-archive.el
  2. 1 1
      lisp/org-attach.el
  3. 19 8
      lisp/org-clock.el
  4. 3 2
      lisp/org.el
  5. 20 1
      testing/lisp/test-org-clock.el

+ 12 - 14
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))

+ 1 - 1
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

+ 19 - 8
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: ")

+ 3 - 2
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)

+ 20 - 1
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\"."