summaryrefslogtreecommitdiff
path: root/lisp/org-clock.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/org-clock.el')
-rw-r--r--lisp/org-clock.el500
1 files changed, 241 insertions, 259 deletions
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 6e58ce9..cb6a6c9 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1,6 +1,6 @@
;;; org-clock.el --- The time clocking code for Org mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -65,7 +65,7 @@ Do not check directly this variable in a Lisp program. Call
function `org-clock-into-drawer' instead."
:group 'org-todo
:group 'org-clock
- :version "25.2"
+ :version "26.1"
:package-version '(Org . "8.3")
:type '(choice
(const :tag "Always" t)
@@ -321,7 +321,9 @@ For more information, see `org-clocktable-write-default'."
'(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at")
("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at")
("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à")
- ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at"))
+ ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at")
+ ("de" "Datei" "E" "Zeitstempel" "Kopfzeile" "Dauer" "GESAMT"
+ "Gesamtdauer" "Dateizeit" "Erstellt am"))
"Terms used in clocktable, translated to different languages."
:group 'org-clocktable
:version "24.1"
@@ -1585,26 +1587,27 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(insert "--")
(setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
(setq s (- (float-time
- (apply #'encode-time (org-parse-time-string te)))
+ (apply #'encode-time (org-parse-time-string te nil t)))
(float-time
- (apply #'encode-time (org-parse-time-string ts))))
+ (apply #'encode-time (org-parse-time-string ts nil t))))
h (floor (/ s 3600))
s (- s (* 3600 h))
m (floor (/ s 60))
s (- s (* 60 s)))
(insert " => " (format "%2d:%02d" h m))
- (when (setq remove (and org-clock-out-remove-zero-time-clocks
- (= (+ h m) 0)))
- (beginning-of-line 1)
- (delete-region (point) (point-at-eol))
- (and (looking-at "\n") (> (point-max) (1+ (point)))
- (delete-char 1)))
(move-marker org-clock-marker nil)
(move-marker org-clock-hd-marker nil)
- (when org-log-note-clock-out
- (org-add-log-setup
- 'clock-out nil nil nil
- (concat "# Task: " (org-get-heading t) "\n\n")))
+ ;; Possibly remove zero time clocks. However, do not add
+ ;; a note associated to the CLOCK line in this case.
+ (cond ((and org-clock-out-remove-zero-time-clocks
+ (= (+ h m) 0))
+ (setq remove t)
+ (delete-region (line-beginning-position)
+ (line-beginning-position 2)))
+ (org-log-note-clock-out
+ (org-add-log-setup
+ 'clock-out nil nil nil
+ (concat "# Task: " (org-get-heading t) "\n\n"))))
(when org-clock-mode-line-timer
(cancel-timer org-clock-mode-line-timer)
(setq org-clock-mode-line-timer nil))
@@ -1820,9 +1823,9 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
(setq ts (match-string 2)
te (match-string 3)
ts (float-time
- (apply #'encode-time (org-parse-time-string ts)))
+ (apply #'encode-time (org-parse-time-string ts nil t)))
te (float-time
- (apply #'encode-time (org-parse-time-string te)))
+ (apply #'encode-time (org-parse-time-string te nil t)))
ts (if tstart (max ts tstart) ts)
te (if tend (min te tend) te)
dt (- te ts)
@@ -1959,7 +1962,8 @@ will be easy to remove."
(make-string
(max 0 (- (- 60 (current-column))
(- (match-end 4) (match-beginning 4))
- (length (org-get-at-bol 'line-prefix)))) ?·)
+ (length (org-get-at-bol 'line-prefix))))
+ ?\·)
'(face shadow))
(org-add-props
(format " %9s " (org-minutes-to-clocksum-string time))
@@ -2407,26 +2411,27 @@ the currently selected interval size."
(org-clock-get-table-data file params)))))
files)
;; Get the right restriction for the scope.
- (cond
- ((not scope)) ;use the restriction as it is now
- ((eq scope 'file) (widen))
- ((eq scope 'subtree) (org-narrow-to-subtree))
- ((eq scope 'tree)
- (while (org-up-heading-safe))
- (org-narrow-to-subtree))
- ((and (symbolp scope)
- (string-match "\\`tree\\([0-9]+\\)\\'"
- (symbol-name scope)))
- (let ((level (string-to-number
- (match-string 1 (symbol-name scope)))))
- (catch 'exit
- (while (org-up-heading-safe)
- (looking-at org-outline-regexp)
- (when (<= (org-reduced-level (funcall outline-level))
- level)
- (throw 'exit nil))))
- (org-narrow-to-subtree))))
- (list (org-clock-get-table-data nil params))))
+ (save-restriction
+ (cond
+ ((not scope)) ;use the restriction as it is now
+ ((eq scope 'file) (widen))
+ ((eq scope 'subtree) (org-narrow-to-subtree))
+ ((eq scope 'tree)
+ (while (org-up-heading-safe))
+ (org-narrow-to-subtree))
+ ((and (symbolp scope)
+ (string-match "\\`tree\\([0-9]+\\)\\'"
+ (symbol-name scope)))
+ (let ((level (string-to-number
+ (match-string 1 (symbol-name scope)))))
+ (catch 'exit
+ (while (org-up-heading-safe)
+ (looking-at org-outline-regexp)
+ (when (<= (org-reduced-level (funcall outline-level))
+ level)
+ (throw 'exit nil))))
+ (org-narrow-to-subtree))))
+ (list (org-clock-get-table-data nil params)))))
(multifile
;; Even though `file-with-archives' can consist of
;; multiple files, we consider this is one extended file
@@ -2457,35 +2462,40 @@ from the dynamic block definition."
(multifile (plist-get params :multifile))
(block (plist-get params :block))
(sort (plist-get params :sort))
- (header (plist-get params :header))
- (narrow (plist-get params :narrow))
+ (header (plist-get params :header))
(ws (or (plist-get params :wstart) 1))
(ms (or (plist-get params :mstart) 1))
(link (plist-get params :link))
- (maxlevel (or (plist-get params :maxlevel) 3))
- (emph (plist-get params :emphasize))
- (level-p (plist-get params :level))
(org-time-clocksum-use-effort-durations
(plist-get params :effort-durations))
+ (maxlevel (or (plist-get params :maxlevel) 3))
+ (emph (plist-get params :emphasize))
+ (compact? (plist-get params :compact))
+ (narrow (or (plist-get params :narrow) (and compact? '40!)))
+ (level? (and (not compact?) (plist-get params :level)))
(timestamp (plist-get params :timestamp))
(properties (plist-get params :properties))
- (ntcol (max 1 (or (plist-get params :tcolumns) 100)))
- (indent (plist-get params :indent))
+ (time-columns
+ (if (or compact? (< maxlevel 2)) 1
+ ;; Deepest headline level is a hard limit for the number
+ ;; of time columns.
+ (let ((levels
+ (cl-mapcan
+ (lambda (table)
+ (pcase table
+ (`(,_ ,(and (pred wholenump) (pred (/= 0))) ,entries)
+ (mapcar #'car entries))))
+ tables)))
+ (min maxlevel
+ (or (plist-get params :tcolumns) 100)
+ (if (null levels) 1 (apply #'max levels))))))
+ (indent (or compact? (plist-get params :indent)))
+ (formula (plist-get params :formula))
(case-fold-search t)
- range-text total-time tbl level hlc formula pcol
- file-time entries entry headline
- recalc content narrow-cut-p tcol)
-
- ;; Implement abbreviations
- (when (plist-get params :compact)
- (setq level nil indent t narrow (or narrow '40!) ntcol 1))
-
- ;; Some consistency test for parameters
- (unless (integerp ntcol)
- (setq params (plist-put params :tcolumns (setq ntcol 100))))
+ range-text total-time recalc narrow-cut-p)
(when (and narrow (integerp narrow) link)
- ;; We cannot have both integer narrow and link
+ ;; We cannot have both integer narrow and link.
(message
"Using hard narrowing in clocktable to allow for links")
(setq narrow (intern (format "%d!" narrow))))
@@ -2503,19 +2513,19 @@ from the dynamic block definition."
narrow))))
(when block
- ;; Get the range text for the header
+ ;; Get the range text for the header.
(setq range-text (nth 2 (org-clock-special-range block nil t ws ms))))
- ;; Compute the total time
- (setq total-time (apply '+ (mapcar 'cadr tables)))
+ ;; Compute the total time.
+ (setq total-time (apply #'+ (mapcar #'cadr tables)))
- ;; Now we need to output this tsuff
+ ;; Now we need to output this tsuff.
(goto-char ipos)
- ;; Insert the text *before* the actual table
+ ;; Insert the text *before* the actual table.
(insert-before-markers
(or header
- ;; Format the standard header
+ ;; Format the standard header.
(concat
"#+CAPTION: "
(nth 9 lwords) " ["
@@ -2529,151 +2539,137 @@ from the dynamic block definition."
;; Insert the narrowing line
(when (and narrow (integerp narrow) (not narrow-cut-p))
(insert-before-markers
- "|" ; table line starter
- (if multifile "|" "") ; file column, maybe
- (if level-p "|" "") ; level column, maybe
- (if timestamp "|" "") ; timestamp column, maybe
- (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
- (format "<%d>| |\n" narrow))) ; headline and time columns
+ "|" ;table line starter
+ (if multifile "|" "") ;file column, maybe
+ (if level? "|" "") ;level column, maybe
+ (if timestamp "|" "") ;timestamp column, maybe
+ (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
+ (format "<%d>| |\n" narrow))) ; headline and time columns
;; Insert the table header line
(insert-before-markers
- "|" ; table line starter
- (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe
- (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe
- (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe
- (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe
- (concat (nth 4 lwords) "|"
- (nth 5 lwords) "|\n")) ; headline and time columns
+ "|" ;table line starter
+ (if multifile (concat (nth 1 lwords) "|") "") ;file column, maybe
+ (if level? (concat (nth 2 lwords) "|") "") ;level column, maybe
+ (if timestamp (concat (nth 3 lwords) "|") "") ;timestamp column, maybe
+ (if properties ;properties columns, maybe
+ (concat (mapconcat #'identity properties "|") "|")
+ "")
+ (concat (nth 4 lwords) "|") ;headline
+ (concat (nth 5 lwords) "|") ;time column
+ (make-string (max 0 (1- time-columns)) ?|) ;other time columns
+ (if (eq formula '%) "%|\n" "\n"))
;; Insert the total time in the table
(insert-before-markers
- "|-\n" ; a hline
- "|" ; table line starter
+ "|-\n" ;a hline
+ "|" ;table line starter
(if multifile (concat "| " (nth 6 lwords) " ") "")
- ; file column, maybe
- (if level-p "|" "") ; level column, maybe
- (if timestamp "|" "") ; timestamp column, maybe
- (if properties (make-string (length properties) ?|) "") ; properties columns, maybe
- (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline
+ ;file column, maybe
+ (if level? "|" "") ;level column, maybe
+ (if timestamp "|" "") ;timestamp column, maybe
+ (make-string (length properties) ?|) ;properties columns, maybe
+ (concat (format org-clock-total-time-cell-format (nth 7 lwords))
+ "| ")
(format org-clock-total-time-cell-format
- (org-minutes-to-clocksum-string (or total-time 0))) ; the time
- "|\n") ; close line
-
- ;; Now iterate over the tables and insert the data
- ;; but only if any time has been collected
+ (org-minutes-to-clocksum-string (or total-time 0))) ;time
+ "|"
+ (make-string (max 0 (1- time-columns)) ?|)
+ (cond ((not (eq formula '%)) "")
+ ((or (not total-time) (= total-time 0)) "0.0|")
+ (t "100.0|"))
+ "\n")
+
+ ;; Now iterate over the tables and insert the data but only if any
+ ;; time has been collected.
(when (and total-time (> total-time 0))
-
- (while (setq tbl (pop tables))
- ;; now tbl is the table resulting from one file.
- (setq file-time (nth 1 tbl))
+ (pcase-dolist (`(,file-name ,file-time ,entries) tables)
(when (or (and file-time (> file-time 0))
(not (plist-get params :fileskip0)))
- (insert-before-markers "|-\n") ; a hline because a new file starts
- ;; First the file time, if we have multiple files
+ (insert-before-markers "|-\n") ;hline at new file
+ ;; First the file time, if we have multiple files.
(when multifile
- ;; Summarize the time collected from this file
+ ;; Summarize the time collected from this file.
(insert-before-markers
(format (concat "| %s %s | %s%s"
- (format org-clock-file-time-cell-format (nth 8 lwords))
+ (format org-clock-file-time-cell-format
+ (nth 8 lwords))
" | *%s*|\n")
- (file-name-nondirectory (car tbl))
- (if level-p "| " "") ; level column, maybe
- (if timestamp "| " "") ; timestamp column, maybe
- (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
- (org-minutes-to-clocksum-string (nth 1 tbl))))) ; the time
+ (file-name-nondirectory file-name)
+ (if level? "| " "") ;level column, maybe
+ (if timestamp "| " "") ;timestamp column, maybe
+ (if properties ;properties columns, maybe
+ (make-string (length properties) ?|)
+ "")
+ (org-minutes-to-clocksum-string file-time)))) ;time
;; Get the list of node entries and iterate over it
- (setq entries (nth 2 tbl))
- (while (setq entry (pop entries))
- (setq level (car entry)
- headline (nth 1 entry)
- hlc (if emph (or (cdr (assoc level hlchars)) "") ""))
- (when narrow-cut-p
- (if (and (string-match (concat "\\`" org-bracket-link-regexp
- "\\'")
- headline)
- (match-end 3))
- (setq headline
- (format "[[%s][%s]]"
- (match-string 1 headline)
- (org-shorten-string (match-string 3 headline)
- narrow)))
- (setq headline (org-shorten-string headline narrow))))
- (insert-before-markers
- "|" ; start the table line
- (if multifile "|" "") ; free space for file name column?
- (if level-p (format "%d|" (car entry)) "") ; level, maybe
- (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe
- (if properties
- (concat
- (mapconcat
- (lambda (p) (or (cdr (assoc p (nth 4 entry))) ""))
- properties "|") "|") "") ;properties columns, maybe
- (if indent (org-clocktable-indent-string level) "") ; indentation
- hlc headline hlc "|" ; headline
- (make-string (min (1- ntcol) (or (- level 1))) ?|)
- ; empty fields for higher levels
- hlc (org-minutes-to-clocksum-string (nth 3 entry)) hlc ; time
- "|\n" ; close line
- )))))
- ;; When exporting subtrees or regions the region might be
- ;; activated, so let's disable ̀delete-active-region'
- (let ((delete-active-region nil)) (backward-delete-char 1))
- (if (setq formula (plist-get params :formula))
- (cond
- ((eq formula '%)
- ;; compute the column where the % numbers need to go
- (setq pcol (+ 2
- (length properties)
- (if multifile 1 0)
- (if level-p 1 0)
- (if timestamp 1 0)
- (min maxlevel (or ntcol 100))))
- ;; compute the column where the total time is
- (setq tcol (+ 2
- (length properties)
- (if multifile 1 0)
- (if level-p 1 0)
- (if timestamp 1 0)))
- (insert
- (format
- "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f"
- pcol ; the column where the % numbers should go
- (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time
- tcol ; column of the total time
- tcol (1- pcol) ; range of columns where times can be found
- ))
- (setq recalc t))
- ((stringp formula)
- (insert "\n#+TBLFM: " formula)
- (setq recalc t))
- (t (error "Invalid formula in clocktable")))
- ;; Should we rescue an old formula?
- (when (stringp (setq content (plist-get params :content)))
- (when (string-match "^\\([ \t]*#\\+tblfm:.*\\)" content)
+ (when (> maxlevel 0)
+ (pcase-dolist (`(,level ,headline ,ts ,time ,props) entries)
+ (when narrow-cut-p
+ (setq headline
+ (if (and (string-match
+ (format "\\`%s\\'" org-bracket-link-regexp)
+ headline)
+ (match-end 3))
+ (format "[[%s][%s]]"
+ (match-string 1 headline)
+ (org-shorten-string (match-string 3 headline)
+ narrow))
+ (org-shorten-string headline narrow))))
+ (let ((hlc (if emph (or (cdr (assoc level hlchars)) "") "")))
+ (insert-before-markers
+ "|" ;start the table line
+ (if multifile "|" "") ;free space for file name column?
+ (if level? (format "%d|" level) "") ;level, maybe
+ (if timestamp (concat ts "|") "") ;timestamp, maybe
+ (if properties ;properties columns, maybe
+ (concat (mapconcat (lambda (p)
+ (or (cdr (assoc p props)) ""))
+ properties
+ "|")
+ "|")
+ "")
+ (if indent ;indentation
+ (org-clocktable-indent-string level)
+ "")
+ hlc headline hlc "|" ;headline
+ ;; Empty fields for higher levels.
+ (make-string (max 0 (1- (min time-columns level))) ?|)
+ hlc (org-minutes-to-clocksum-string time) hlc "|" ; time
+ (make-string (max 0 (- time-columns level)) ?|)
+ (if (eq formula '%)
+ (format "%.1f |" (* 100 (/ time (float total-time))))
+ "")
+ "\n")))))))
+ (delete-char -1)
+ (cond
+ ;; Possibly rescue old formula?
+ ((or (not formula) (eq formula '%))
+ (let ((contents (org-string-nw-p (plist-get params :content))))
+ (when (and contents (string-match "^\\([ \t]*#\\+tblfm:.*\\)" contents))
(setq recalc t)
- (insert "\n" (match-string 1 (plist-get params :content)))
+ (insert "\n" (match-string 1 contents))
(beginning-of-line 0))))
- ;; Back to beginning, align the table, recalculate if necessary
+ ;; Insert specified formula line.
+ ((stringp formula)
+ (insert "\n#+TBLFM: " formula)
+ (setq recalc t))
+ (t
+ (user-error "Invalid :formula parameter in clocktable")))
+ ;; Back to beginning, align the table, recalculate if necessary.
(goto-char ipos)
(skip-chars-forward "^|")
(org-table-align)
(when org-hide-emphasis-markers
- ;; we need to align a second time
+ ;; We need to align a second time.
(org-table-align))
(when sort
(save-excursion
(org-table-goto-line 3)
(org-table-goto-column (car sort))
(org-table-sort-lines nil (cdr sort))))
- (when recalc
- (if (eq formula '%)
- (save-excursion
- (if (and narrow (not narrow-cut-p)) (beginning-of-line 2))
- (org-table-goto-column pcol nil 'force)
- (insert "%")))
- (org-table-recalculate 'all))
+ (when recalc (org-table-recalculate 'all))
total-time))
(defun org-clocktable-indent-string (level)
@@ -2705,14 +2701,16 @@ LEVEL is an integer. Indent by two spaces per level above 1."
(pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute ts)))
(setq ts (float-time (encode-time 0 0 0 day month year)))))
(ts
- (setq ts (float-time (apply #'encode-time (org-parse-time-string ts))))))
+ (setq ts (float-time
+ (apply #'encode-time (org-parse-time-string ts nil t))))))
(cond
((numberp te)
;; Likewise for te.
(pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute te)))
(setq te (float-time (encode-time 0 0 0 day month year)))))
(te
- (setq te (float-time (apply #'encode-time (org-parse-time-string te))))))
+ (setq te (float-time
+ (apply #'encode-time (org-parse-time-string te nil t))))))
(setq tsb
(if (eq step0 'week)
(- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws)))
@@ -2752,19 +2750,22 @@ file time (in minutes) as 1st and 2nd elements. The third element
of this list will be a list of headline entries. Each entry has the
following structure:
- (LEVEL HEADLINE TIMESTAMP TIME)
-
-LEVEL: The level of the headline, as an integer. This will be
- the reduced level, so 1,2,3,... even if only odd levels
- are being used.
-HEADLINE: The text of the headline. Depending on PARAMS, this may
- already be formatted like a link.
-TIMESTAMP: If PARAMS require it, this will be a time stamp found in the
- entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive,
- in this sequence.
-TIME: The sum of all time spend in this tree, in minutes. This time
- will of cause be restricted to the time block and tags match
- specified in PARAMS."
+ (LEVEL HEADLINE TIMESTAMP TIME PROPERTIES)
+
+LEVEL: The level of the headline, as an integer. This will be
+ the reduced level, so 1,2,3,... even if only odd levels
+ are being used.
+HEADLINE: The text of the headline. Depending on PARAMS, this may
+ already be formatted like a link.
+TIMESTAMP: If PARAMS require it, this will be a time stamp found in the
+ entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive,
+ in this sequence.
+TIME: The sum of all time spend in this tree, in minutes. This time
+ will of cause be restricted to the time block and tags match
+ specified in PARAMS.
+PROPERTIES: The list properties specified in the `:properties' parameter
+ along with their value, as an alist following the pattern
+ (NAME . VALUE)."
(let* ((maxlevel (or (plist-get params :maxlevel) 3))
(timestamp (plist-get params :timestamp))
(ts (plist-get params :tstart))
@@ -2777,7 +2778,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(properties (plist-get params :properties))
(inherit-property-p (plist-get params :inherit-props))
(matcher (and tags (cdr (org-make-tags-matcher tags))))
- cc st p time level hdl props tsp tbl)
+ cc st p tbl)
(setq org-clock-file-total-minutes nil)
(when block
@@ -2809,66 +2810,46 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(setq p (next-single-property-change
(point) :org-clock-minutes)))
(goto-char p)
- (when (setq time (get-text-property p :org-clock-minutes))
- (save-excursion
- (beginning-of-line 1)
- (when (and (looking-at "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$")
- (setq level (org-reduced-level
- (- (match-end 1) (match-beginning 1))))
- (<= level maxlevel))
- (setq hdl (if (not link)
- (match-string 2)
- (org-make-link-string
- (format "file:%s::%s"
- (buffer-file-name)
- (save-match-data
- (match-string 2)))
- (org-make-org-heading-search-string
- (replace-regexp-in-string
- org-bracket-link-regexp
- (lambda (m) (or (match-string 3 m)
- (match-string 1 m)))
- (match-string 2)))))
- tsp (when timestamp
- (setq props (org-entry-properties (point)))
- (or (cdr (assoc "SCHEDULED" props))
- (cdr (assoc "DEADLINE" props))
- (cdr (assoc "TIMESTAMP" props))
- (cdr (assoc "TIMESTAMP_IA" props))))
- props (when properties
- (remove nil
- (mapcar
- (lambda (p)
- (when (org-entry-get (point) p inherit-property-p)
- (cons p (org-entry-get (point) p inherit-property-p))))
- properties))))
- (when (> time 0) (push (list level hdl tsp time props) tbl))))))
- (setq tbl (nreverse tbl))
- (list file org-clock-file-total-minutes tbl))))
-
-(defun org-clock-time% (total &rest strings)
- "Compute a time fraction in percent.
-TOTAL s a time string like 10:21 specifying the total times.
-STRINGS is a list of strings that should be checked for a time.
-The first string that does have a time will be used.
-This function is made for clock tables."
- (let ((re "\\([0-9]+\\):\\([0-9]+\\)")
- tot s)
- (save-match-data
- (catch 'exit
- (if (not (string-match re total))
- (throw 'exit 0.)
- (setq tot (+ (string-to-number (match-string 2 total))
- (* 60 (string-to-number (match-string 1 total)))))
- (if (= tot 0.) (throw 'exit 0.)))
- (while (setq s (pop strings))
- (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
- (throw 'exit
- (/ (* 100.0 (+ (string-to-number (match-string 2 s))
- (* 60 (string-to-number
- (match-string 1 s)))))
- tot))))
- 0))))
+ (let ((time (get-text-property p :org-clock-minutes)))
+ (when (and time (> time 0) (org-at-heading-p))
+ (let ((level (org-reduced-level (org-current-level))))
+ (when (<= level maxlevel)
+ (let* ((headline (replace-regexp-in-string
+ (format "\\`%s[ \t]+" org-comment-string) ""
+ (nth 4 (org-heading-components))))
+ (hdl
+ (if (not link) headline
+ (let ((search
+ (org-make-org-heading-search-string headline)))
+ (org-make-link-string
+ (if (not (buffer-file-name)) search
+ (format "file:%s::%s" (buffer-file-name) search))
+ ;; Prune statistics cookies. Replace
+ ;; links with their description, or
+ ;; a plain link if there is none.
+ (org-trim
+ (org-link-display-format
+ (replace-regexp-in-string
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ headline)))))))
+ (tsp
+ (and timestamp
+ (let ((p (org-entry-properties (point) 'special)))
+ (or (cdr (assoc "SCHEDULED" p))
+ (cdr (assoc "DEADLINE" p))
+ (cdr (assoc "TIMESTAMP" p))
+ (cdr (assoc "TIMESTAMP_IA" p))))))
+ (props
+ (and properties
+ (delq nil
+ (mapcar
+ (lambda (p)
+ (let ((v (org-entry-get
+ (point) p inherit-property-p)))
+ (and v (cons p v))))
+ properties)))))
+ (push (list level hdl tsp time props) tbl)))))))
+ (list file org-clock-file-total-minutes (nreverse tbl)))))
;; Saving and loading the clock
@@ -2906,9 +2887,9 @@ Otherwise, return nil."
(setq ts (match-string 1)
te (match-string 3))
(setq s (- (float-time
- (apply #'encode-time (org-parse-time-string te)))
+ (apply #'encode-time (org-parse-time-string te nil t)))
(float-time
- (apply #'encode-time (org-parse-time-string ts))))
+ (apply #'encode-time (org-parse-time-string ts nil t))))
neg (< s 0)
s (abs s)
h (floor (/ s 3600))
@@ -2927,7 +2908,8 @@ The details of what will be saved are regulated by the variable
org-clock-has-been-used
(not (file-exists-p org-clock-persist-file))))
(with-temp-file org-clock-persist-file
- (insert (format ";; org-persist.el - %s at %s\n"
+ (insert (format ";; %s - %s at %s\n"
+ (file-name-nondirectory org-clock-persist-file)
(system-name)
(format-time-string (org-time-stamp-format t))))
;; Store clock to be resumed.
@@ -2984,7 +2966,7 @@ The details of what will be saved are regulated by the variable
(let ((org-clock-in-resume 'auto-restart)
(org-clock-auto-clock-resolution nil))
(org-clock-in)
- (when (outline-invisible-p) (org-show-context))))))
+ (when (org-invisible-p) (org-show-context))))))
(_ nil)))))
;; Suggested bindings
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-19 15:43:57 +0000