Clocking related new stuff

This commit is contained in:
Benson Chu 2019-03-21 15:40:54 -05:00
parent 43aec2fc72
commit 2d649896df
2 changed files with 179 additions and 2 deletions

View file

@ -229,8 +229,12 @@
(define-key *root-map* (kbd "q") (quickrun-lambda "qutebrowser" nil))
(define-key *root-map* (kbd "V") (quickrun-lambda "VBoxManage startvm \"Windows 7\"" "VirtualBox Machine"))
(define-key *root-map* (kbd "r") 'exwmx-name-buffer)
(define-key *root-map* (kbd ")") (lambda () (interactive) (leaving-computer) (shell-command "sleep 2s ; xset dpms force off")))
(define-key *root-map* (kbd "C-n") 'switch-window)
(define-key *root-map* (kbd ")") (lambda () (interactive) (shell-command "sleep 2s ; xset dpms force off")))
(define-key *root-map* (kbd "i") 'org-mru-clock-in)
(define-key *root-map* (kbd "C-i") 'leaving-computer)
(define-key *root-map* (kbd "C") 'org-resolve-clocks)
(define-key *root-map* (kbd "j") 'org-clock-goto)
(define-key *root-map* (kbd "n") 'toggle-notifications)
(define-prefix-command '*window-map*)
@ -3117,7 +3121,7 @@
#+end_src
** org-mru-clock
#+begin_src emacs-lisp
(use-package org-mru-clock)
(use-package org-mru-clock)
#+end_src
** org-clock-convenience
#+begin_src emacs-lisp

View file

@ -432,3 +432,176 @@ https://github.com/org-trello/org-trello/issues/258
nil win5))
(select-window win0)))
#+end_src
* org-clock-out resolve dangling clock time
#+begin_src emacs-lisp
(defun my/org-clock-out (&optional switch-to-state fail-quietly at-time)
"Stop the currently running clock.
Throw an error if there is no running clock and FAIL-QUIETLY is nil.
With a universal prefix, prompt for a state to switch the clocked out task
to, overriding the existing value of `org-clock-out-switch-to-state'."
(interactive "P")
(catch 'exit
(when (not (org-clocking-p))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(setq frame-title-format org-frame-title-format-backup)
(force-mode-line-update)
(if fail-quietly (throw 'exit t) (user-error "No active clock")))
(let ((org-clock-out-switch-to-state
(if switch-to-state
(completing-read "Switch to state: "
(with-current-buffer
(marker-buffer org-clock-marker)
org-todo-keywords-1)
nil t "DONE")
org-clock-out-switch-to-state))
(now (org-current-time org-clock-rounding-minutes))
ts te s h m remove)
(setq org-clock-out-time (or at-time now)) ;; This line is changed from now to (or at-time now)
(save-excursion ; Do not replace this with `with-current-buffer'.
(with-no-warnings (set-buffer (org-clocking-buffer)))
(save-restriction
(widen)
(goto-char org-clock-marker)
(beginning-of-line 1)
(if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
(equal (match-string 1) org-clock-string))
(setq ts (match-string 2))
(if fail-quietly (throw 'exit nil) (error "Clock start time is gone")))
(goto-char (match-end 0))
(delete-region (point) (point-at-eol))
(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)))
(float-time
(apply #'encode-time (org-parse-time-string ts))))
h (floor (/ s 3600))
s (- s (* 3600 h))
m (floor (/ s 60))
s (- s (* 60 s)))
(insert " => " (format "%2d:%02d" h m))
(move-marker org-clock-marker nil)
(move-marker org-clock-hd-marker nil)
;; 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))
(when org-clock-idle-timer
(cancel-timer org-clock-idle-timer)
(setq org-clock-idle-timer nil))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(setq frame-title-format org-frame-title-format-backup)
(when org-clock-out-switch-to-state
(save-excursion
(org-back-to-heading t)
(let ((org-clock-out-when-done nil))
(cond
((functionp org-clock-out-switch-to-state)
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp))
(let ((newstate (funcall org-clock-out-switch-to-state
(match-string 2))))
(when newstate (org-todo newstate))))
((and org-clock-out-switch-to-state
(not (looking-at (concat org-outline-regexp "[ \t]*"
org-clock-out-switch-to-state
"\\>"))))
(org-todo org-clock-out-switch-to-state))))))
(force-mode-line-update)
(message (concat "Clock stopped at %s after "
(org-duration-from-minutes (+ (* 60 h) m)) "%s")
te (if remove " => LINE REMOVED" ""))
(run-hooks 'org-clock-out-hook)
(unless (org-clocking-p)
(setq org-clock-current-task nil)))))))
(defun my/org-clock-resolve-clock
(clock resolve-to clock-out-time close restart fail-quietly)
"Resolve CLOCK given the time RESOLVE-TO, and the present.
CLOCK is a cons cell of the form (MARKER START-TIME)."
(let ((org-clock-resolving-clocks t)
;; If the clocked entry contained only a clock and possibly
;; the associated drawer, and we either cancel it or clock it
;; out, `org-clock-out-remove-zero-time-clocks' may clear all
;; contents, and leave point on the /next/ headline. We store
;; the current entry location to be able to get back here when
;; we need to clock in again the previously clocked task.
(heading (org-with-point-at (car clock)
(org-back-to-heading t)
(point-marker))))
(pcase resolve-to
(`nil
(org-clock-clock-cancel clock)
(when (and restart (not org-clock-clocking-in))
(org-with-point-at heading (org-clock-in))))
(`now
(cond
(restart (error "RESTART is not valid here"))
((or close org-clock-clocking-in)
(org-clock-clock-out clock fail-quietly))
((org-is-active-clock clock) nil)
(t (org-clock-clock-in clock t))))
((pred (time-less-p (current-time)))
;; ^ NOTE: Here and in other `time-less-p' calls, we use
;; (current-time) rather than nil for Emacs 24 compatibility.
(error "RESOLVE-TO must refer to a time in the past"))
(_
(when restart (error "RESTART is not valid here"))
(org-clock-clock-out clock fail-quietly (or clock-out-time resolve-to))
(cond
(org-clock-clocking-in nil)
(close
(setq org-clock-leftover-time (and (null clock-out-time) resolve-to))
(move-marker org-clock-marker nil))
(t
(org-with-point-at heading
(org-clock-in nil (and clock-out-time resolve-to)))))))))
(advice-add 'org-clock-out
:override
#'my/org-clock-out)
(advice-add 'org-clock-resolve-clock
:override
#'my/org-clock-resolve-clock)
#+end_src
* Modifications to the switch buffer functions
#+begin_src emacs-lisp
(defvar switch-buffer-functions--in-minibuffer nil)
;;;###autoload
(defun switch-buffer-functions-run ()
"Run `switch-buffer-functions' if needed.
This function checks the result of `current-buffer', and run
`switch-buffer-functions' when it has been changed from
the last buffer.
This function should be hooked to `post-command-hook'."
(when (and switch-buffer-functions--in-minibuffer
(member this-command '(exit-minibuffer minibuffer-keyboard-quit ivy-alt-done)))
(setq switch-buffer-functions--in-minibuffer nil))
(if (member this-command '(eval-expression counsel-M-x ivy-switch-buffer edebug-eval-expression)) ;; counsel-M-x doesn't work...
(setq switch-buffer-functions--in-minibuffer t)
(unless (or (eq (current-buffer)
switch-buffer-functions--last-buffer))
(let ((current (current-buffer))
(previous switch-buffer-functions--last-buffer))
(setq switch-buffer-functions--last-buffer
current)
(run-hook-with-args 'switch-buffer-functions
previous
current)))))
#+end_src