Skip to content

Instantly share code, notes, and snippets.

@heikkil
Last active September 24, 2019 19:14
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save heikkil/76e8fbae3fbf6599870e6c0ca1f3c62b to your computer and use it in GitHub Desktop.
Save heikkil/76e8fbae3fbf6599870e6c0ca1f3c62b to your computer and use it in GitHub Desktop.
Merge the org CLOCK line with the next CLOCK line
(defun org-clock-merge (arg)
"Merge the org CLOCK line with the next CLOCK line.
Requires that the time ranges in two lines overlap, i.e. the
start time of the first line and the second time of the second
line are identical.
If the testing fails, move the cursor one line down.
Universal argument ARG overrides the test and merges
the lines even if the ranges do not overlap."
(interactive "P")
(let* ((org-clock-regexp (concat "CLOCK: " org-ts-regexp3 "--" org-ts-regexp3))
(first-line-start (line-beginning-position))
(first-line (buffer-substring
(line-beginning-position) (line-end-position)))
(first-line-t1 (if (string-match org-clock-regexp first-line)
(match-string 1 first-line)
(progn
(forward-line)
(user-error "The first line must have a valid CLOCK range"))))
(first-line-t2 (match-string 9 first-line))
(second-line (progn
(forward-line)
(buffer-substring
(line-beginning-position) (line-end-position))))
(second-line-t1 (if (string-match org-clock-regexp second-line)
(match-string 1 second-line)
(user-error "The second line must have a valid CLOCK range")))
(second-line-t2 (match-string 9 second-line)))
;; check if lines should be merged
(unless (or arg (equal first-line-t1 second-line-t2))
(user-error "Clock ranges not continuous. Override with universal argument"))
;; remove the two lines
(delete-region first-line-start (line-end-position))
;; indent
(org-cycle)
;; insert new time range
(insert (concat "CLOCK: [" second-line-t1 "]--[" first-line-t2 "]"))
;; generate duration
(org-ctrl-c-ctrl-c)))
@emonigma
Copy link

I missed this change and added code of my own. The main benefit is that I call this function automatically after clocking out, so I don't need to move point to the last clock-out line.

(defun org-get-timestamps (line)
  "Parses a clock segment line and returns the first and last timestamps in a list."
  (let* ((first-timestamp-start (cl-search "[" line))
	 (first-timestamp-end (+ 1 (cl-search "]" line)))
	 (first-timestamp (substring line first-timestamp-start first-timestamp-end))
	 (last-timestamp-start (cl-search "[" line :from-end t))
	 (last-timestamp-end (+ 1 (cl-search "]" line :from-end t)))
	 (last-timestamp (substring line last-timestamp-start last-timestamp-end)))
    (cons first-timestamp (cons last-timestamp '()))))

(defun org-compute-timestamp-difference (later-timestamp earlier-timestamp)
  "Computes the difference in string timestamps as a float."
  (-
   (float-time (apply #'encode-time (org-parse-time-string later-timestamp)))
   (float-time (apply #'encode-time (org-parse-time-string earlier-timestamp)))))
  
(defun org-float-time-diff-to-hours-minutes (diff)
  "Returns a float time difference in hh:mm format."
  (let* ((hours (floor (/ diff 3600)))
	 (diff_minus_hours (- diff (* 3600 hours)))
	 (minutes (floor (/ diff_minus_hours 60))))
    (format "%2d:%02d" hours minutes)))

(defun org-clock-merge (&optional skip-merge-with-time-discrepancy)
  "Merge the org CLOCK line with the next CLOCK line. If the last
timestamp of the current line equals the first timestamp of the
next line, i.e. no discrepancy exists, then merge
automatically. If a discrepancy exists, prompt the user for
confirmation, unless skip-merge-with-time-discrepancy is
non-nil."

  (interactive)
  (let (
	this-clock-line this-timestamp-1 this-timestamp-2
			next-clock-line next-timestamp-1 next-timestamp-2
			timestamp-end first-timestamp-index last-timestamp-index)
    ;; is this line a valid CLOCK line?
    (setq this-clock-line
          (buffer-substring (line-beginning-position) (line-end-position)))
    (if (not (string-match org-ts-regexp-both this-clock-line))
        (error "Cursor must be placed on line with a valid CLOCK entry"))

    ;; is next line a valid CLOCK line?
    (forward-line)
    (setq next-clock-line
          (buffer-substring (line-beginning-position) (line-end-position)))
    (if (not (string-match org-ts-regexp-both next-clock-line))
        (error "Next line must have a valid CLOCK entry"))

    ;; Get first timestamp of this line (latest-timestamp) and last time stamp
    ;; of next line (earliest-timestamp) and check if lines should be merged
    (let* ((these-timestamps (org-get-timestamps this-clock-line))
	   (next-timestamps (org-get-timestamps next-clock-line)))
      (setq this-timestamp-1 (pop these-timestamps)
	    this-timestamp-2 (pop these-timestamps)
	    next-timestamp-1 (pop next-timestamps)
	    next-timestamp-2 (pop next-timestamps))
      (let ((diff (org-compute-timestamp-difference this-timestamp-1 next-timestamp-2)))
	(when (> diff 0)
	  (when skip-merge-with-time-discrepancy
	    (error "Skipping clock-merge"))
	  (unless (yes-or-no-p (concat "Problem with merging: discrepancy of "
				       (org-float-time-diff-to-hours-minutes diff)
				       " between times to merge. Proceed anyway?"))
	    (error "Cancelled org-clock-merge")))))
    
    ;; copy the end of time range
    (forward-line -1)
    (move-beginning-of-line nil)
    (re-search-forward "--")
    (setq timestamp-end (buffer-substring (point) (line-end-position)))
    ;; remove the first line
    (delete-region (line-beginning-position) (1+ (line-end-position)))
    ;; replace the end timestamp
    (re-search-forward "--")
    (delete-region (point) (line-end-position))
    (insert timestamp-end)
    ;; update timestamp to reflect new duration
    (org-ctrl-c-ctrl-c)))

(defun org-try-merging-last-clock-out ()
  "Try to merge the latest clock-out, and catch the error if the discrepancy is not zero."
  (save-restriction
    (save-excursion
      (org-clock-goto)
      (search-forward org-last-inserted-timestamp)
      (condition-case nil
	  (org-clock-merge t)
	(error)))))

(add-hook 'org-clock-out-hook #'org-try-merging-last-clock-out)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment