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

This commit is contained in:
Bastien 2018-11-02 09:23:15 +01:00
commit 9cb0470723
5 changed files with 55 additions and 26 deletions

View File

@ -160,20 +160,18 @@ archive file is."
(defun org-all-archive-files () (defun org-all-archive-files ()
"Get a list of all archive files used in the current buffer." "Get a list of all archive files used in the current buffer."
(let ((case-fold-search t) (let (files)
files) (org-with-point-at 1
(org-with-wide-buffer (let ((regexp "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)")
(goto-char (point-min)) (case-fold-search t))
(while (re-search-forward (while (re-search-forward regexp nil t)
"^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)" (when (save-match-data
nil t) (if (equal ":" (match-string 1)) (org-at-property-p)
(when (save-match-data (eq 'keyword (org-element-type (org-element-at-point)))))
(if (eq (match-string 1) ":") (org-at-property-p) (let ((file (org-extract-archive-file
(eq (org-element-type (org-element-at-point)) 'keyword))) (match-string-no-properties 2))))
(let ((file (org-extract-archive-file (when (and (org-string-nw-p file) (file-exists-p file))
(match-string-no-properties 2)))) (push file files)))))))
(when (and (org-string-nw-p file) (file-exists-p file))
(push file files))))))
(setq files (nreverse files)) (setq files (nreverse files))
(let ((file (org-extract-archive-file))) (let ((file (org-extract-archive-file)))
(when (and (org-string-nw-p file) (file-exists-p file)) (when (and (org-string-nw-p file) (file-exists-p file))

View File

@ -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. s Set a specific attachment directory for this entry or reset to default.
i Make children of the current entry inherit its attachment directory."))) i Make children of the current entry inherit its attachment directory.")))
(org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) (org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
(message "Select command: [acmlzoOfFdD]") (message "Select command: [acmlyunzoOfFdD]")
(setq c (read-char-exclusive)) (setq c (read-char-exclusive))
(and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*")))) (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))
(cond (cond

View File

@ -2681,6 +2681,15 @@ LEVEL is an integer. Indent by two spaces per level above 1."
(if (= level 1) "" (if (= level 1) ""
(concat "\\_" (make-string (* 2 (1- level)) ?\s)))) (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) (defun org-clocktable-steps (params)
"Step through the range to make a number of clock tables." "Step through the range to make a number of clock tables."
(let* ((ts (plist-get params :tstart)) (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)) (ws (plist-get params :wstart))
(ms (plist-get params :mstart)) (ms (plist-get params :mstart))
(step0 (plist-get params :step)) (step0 (plist-get params :step))
(step (cdr (assq step0 '((day . 86400) (week . 604800)))))
(stepskip0 (plist-get params :stepskip0)) (stepskip0 (plist-get params :stepskip0))
(block (plist-get params :block)) (block (plist-get params :block))
cc tsb) cc tsb)
@ -2715,16 +2723,19 @@ LEVEL is an integer. Indent by two spaces per level above 1."
(if (eq step0 'week) (if (eq step0 'week)
(let ((dow (nth 6 (decode-time (seconds-to-time ts))))) (let ((dow (nth 6 (decode-time (seconds-to-time ts)))))
(if (<= dow ws) ts (if (<= dow ws) ts
(- ts (* 86400 (- dow ws))))) (org-clocktable-increment-day ts ; decrement
(- ws dow))))
ts)) ts))
(while (< tsb te) (while (< tsb te)
(unless (bolp) (insert "\n")) (unless (bolp) (insert "\n"))
(let ((start-time (seconds-to-time (max tsb ts)))) (let* ((start-time (seconds-to-time (max tsb ts)))
(cl-incf tsb (let ((dow (nth 6 (decode-time (seconds-to-time tsb))))) (dow (nth 6 (decode-time (seconds-to-time tsb))))
(if (or (eq step0 'day) (days-to-skip (cond ((eq step0 'day) 1)
(= dow ws)) ;; else 'week:
step ((= dow ws) 7)
(* 86400 (- ws dow))))) (t (- ws dow)))))
(setq tsb (time-to-seconds (org-clocktable-increment-day tsb
days-to-skip)))
(insert "\n" (insert "\n"
(if (eq step0 'day) "Daily report: " (if (eq step0 'day) "Daily report: "
"Weekly report starting on: ") "Weekly report starting on: ")

View File

@ -17500,7 +17500,7 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
h (string-to-number (match-string 2 s))) h (string-to-number (match-string 2 s)))
(if (org-pos-in-match-range pos 2) (if (org-pos-in-match-range pos 2)
(setq h (+ h n)) (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))) (unless (= 0 (setq rem (% m dm)))
(setq m (+ m (if (> n 0) (- rem) (- dm rem))))) (setq m (+ m (if (> n 0) (- rem) (- dm rem)))))
(setq m (+ m n))) (setq m (+ m n)))
@ -22977,7 +22977,8 @@ interactive command with similar behavior."
(end-of-line) (end-of-line)
(null (re-search-backward org-outline-regexp-bol nil t))))) (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)) (outline-on-heading-p t))
(defun org-in-commented-heading-p (&optional no-inheritance) (defun org-in-commented-heading-p (&optional no-inheritance)

View File

@ -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")) (let ((system-time-locale "en_US"))
(test-org-clock-clocktable-contents (test-org-clock-clocktable-contents
(concat ":step day :tstart \"<2017-12-25 Mon>\" " (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 () (ert-deftest test-org-clock/clocktable/extend-today-until ()
"Test assignment of clock time to days in presence of \"org-extend-today-until\"." "Test assignment of clock time to days in presence of \"org-extend-today-until\"."