Refile clock entries and some basic settings

5 files changed, 176 insertions, 17 deletions

diff --git a/emacs/.emacs.d/init/ycp-basic.el b/emacs/.emacs.d/init/ycp-basic.el
index 07bb11f..12000e5 100644
--- a/emacs/.emacs.d/init/ycp-basic.el
+++ b/emacs/.emacs.d/init/ycp-basic.el
@@ -30,13 +30,6 @@
 ;;; Code:
 
 
-(setq use-short-answers t)
-(prefer-coding-system 'utf-8)
-(set-default-coding-systems 'utf-8)
-(set-terminal-coding-system 'utf-8)
-(set-keyboard-coding-system 'utf-8)
-(set-language-environment 'utf-8)
-
 (my-configure
   (my-keybind global-map
     "C-x C-c" nil
@@ -44,6 +37,14 @@
     "C-x C-z" nil
     )
   (setq auth-source-save-behavior nil)
+  (setq use-short-answers t)
+  (prefer-coding-system 'utf-8)
+  (set-default-coding-systems 'utf-8)
+  (set-terminal-coding-system 'utf-8)
+  (set-keyboard-coding-system 'utf-8)
+  (set-language-environment 'utf-8)
+  (setq load-prefer-newer t)
+  (setq message-log-max 16384)
   )
 
 (my-configure
diff --git a/emacs/.emacs.d/init/ycp-editing.el b/emacs/.emacs.d/init/ycp-editing.el
index 4b6922e..ab1bc9e 100644
--- a/emacs/.emacs.d/init/ycp-editing.el
+++ b/emacs/.emacs.d/init/ycp-editing.el
@@ -36,6 +36,11 @@
 (setq bidi-inhibit-bpa t)
 (setq save-interprogram-paste-before-kill t)
 (setq kill-ring-max 200)
+(setq sentence-end-double-space nil)
+(setq show-paren-delay 0)
+(setq window-divider-default-bottom-width 1)
+(setq window-divider-default-places 'bottom-only)
+(define-key input-decode-map [?\C-m] [C-m])  ; don't interpret C-m as RET
 
 (my-package my-editing
   (:delay 5)
@@ -61,6 +66,10 @@
     "C-M-y" #'my-yank-primary
     "C-a" #'my-beginning-of-line-or-indentation
     "M-c" #'my-copy-buffer-file-name    ; override capitalize
+    "M-o" #'delete-blank-lines            ; alias for C-x C-o
+    "M-SPC" #'cycle-spacing
+    "M-z" #'zap-up-to-char                ; NOT `zap-to-char'
+    "<C-M-backspace>" #'backward-kill-sexp
     )
   (electric-pair-mode)
   )
@@ -73,12 +82,16 @@
 (define-key global-map (kbd "C-c r r") 'replace-regexp)
 (define-key global-map (kbd "C-c r s") 'replace-string)
 
-(my-keybind global-map
-  "M-o" #'delete-blank-lines            ; alias for C-x C-o
-  "M-SPC" #'cycle-spacing
-  "M-z" #'zap-up-to-char                ; NOT `zap-to-char'
-  "<C-M-backspace>" #'backward-kill-sexp
-  )
+(my-package aggressive-indent
+  (:install t)
+  (:delay 15)
+  (add-hook 'emacs-lisp-mode-hook #'aggressive-indent-mode))
+
+(my-package avy
+  (:install t)
+  (:delay 15)
+  (my-keybind global-map "C-." #'avy-goto-char-timer)
+  (setq avy-keys '(97 115 100 102 103 104 106 107 108)))
 
 (my-package pyim
   (:delay 30)
@@ -109,11 +122,14 @@
 
 (put 'narrow-to-region 'disabled nil)
 
-(setq large-file-warning-threshold 15000000)
+(setq large-file-warning-threshold nil)
+(setq x-stretch-cursor t)
+(setq delete-old-versions t)
+(setq version-control t)
 
 (add-hook 'text-mode-hook #'turn-on-auto-fill)
 (add-to-list
  'auto-mode-alist
  '("\\(README\\|CHANGELOG\\|COPYING\\|LICENSE\\)\\'" . text-mode))
-
+(add-hook 'before-save-hook 'time-stamp)
 (provide 'ycp-editing)
diff --git a/emacs/.emacs.d/init/ycp-gnus.el b/emacs/.emacs.d/init/ycp-gnus.el
index 6eef1cd..d8ae4ed 100644
--- a/emacs/.emacs.d/init/ycp-gnus.el
+++ b/emacs/.emacs.d/init/ycp-gnus.el
@@ -30,7 +30,6 @@
 
 
 (my-setq-from-local user-mail-address user-full-name)
-(setq mail-user-agent 'message-user-agent)
 (setq auth-sources '("~/.authinfo.gpg"))
 
 ;;;; `mm-encode'
@@ -77,6 +76,7 @@
 ")
   (my-setq-from-local gnus-secondary-select-methods)
   (setq gnus-agent t)
+  (setq mail-user-agent 'gnus-user-agent)
   (dolist (mode '(gnus-group-mode-hook
                   gnus-summary-mode-hook
                   gnus-browse-mode-hook))
diff --git a/emacs/.emacs.d/init/ycp-org.el b/emacs/.emacs.d/init/ycp-org.el
index 513f719..77c4436 100644
--- a/emacs/.emacs.d/init/ycp-org.el
+++ b/emacs/.emacs.d/init/ycp-org.el
@@ -281,6 +281,7 @@
   (setq org-use-speed-commands t)
   (setq org-speed-commands
         '(("User commands")
+          ("W" . my-org-clock-refile-clocking)
           ("+" . my-org-vote-up)
           ("-" . my-org-vote-down)
           ("m" . my-magit-clone-org-source)
diff --git a/emacs/.emacs.d/lisp/my/my-org.el b/emacs/.emacs.d/lisp/my/my-org.el
index 9411f72..4c69484 100644
--- a/emacs/.emacs.d/lisp/my/my-org.el
+++ b/emacs/.emacs.d/lisp/my/my-org.el
@@ -449,6 +449,146 @@ END."
   (when (equal major-mode 'org-mode)
     (org-clock-save)))
 
+(defun my-org-clock-kill-entries ()
+  "Kill all clock entries at the org node at point.
+
+Assuming they are in the logbook drawer"
+  (interactive)
+  (let ((end)
+        (kill-whole-line t))
+    (save-restriction
+      (org-narrow-to-subtree)
+      (goto-char (point-min))
+      (when (re-search-forward "^\\ *:LOGBOOK:\\ *$" nil t)
+        (kill-new "")
+        (setq end (save-excursion
+                    (re-search-forward "^\\ *:END:\\ *$")
+                    (point)))
+        (while (re-search-forward "^\\ *CLOCK: .*--.*$" end t)
+          (beginning-of-line)
+          (append-next-kill)
+          (kill-line))))))
+
+(defun my-org-clock-yank ()
+  "Yank whatever is in the kill ring into the logbook drawer."
+  (interactive)
+  (let ((end))
+    (save-restriction
+      (org-narrow-to-subtree)
+      (goto-char (point-min))
+      (if (re-search-forward "^\\ *:LOGBOOK:\\ *$" nil t)
+          ;; If there's already a logbook, move to where the clock
+          ;; entries should be inserted
+          (progn
+            (setq end (save-excursion
+                        (re-search-forward "^\\ *:END:\\ *$")
+                        (beginning-of-line)
+                        (point)))
+            ;; Insert after active clock (if any)
+            (if (re-search-forward "^\\ *CLOCK: .*--.*$" end t)
+                (beginning-of-line)
+              (goto-char end)))
+        (beginning-of-line 2)
+        (org-insert-drawer nil "LOGBOOK")
+        (delete-char 1))
+      (yank))))
+
+(defun my-org-clock-refile-clocking ()
+  (interactive)
+  (my-org-clock-kill-entries)
+  (save-excursion
+    (call-interactively 'org-goto)
+    (my-org-clock-yank)))
+
+;;; to remove
+(defun my-org-clock-collect-entries (drawer &optional remove)
+  "Collect all clock entries from DRAWER.
+Remove them from DRAWER if REMOVE is non-nil."
+  (cl-assert (eq (org-element-type drawer) 'drawer)
+             nil
+             "Expected a drawer got %s" (org-element-type drawer))
+  (when (string-equal (org-element-property :drawer-name drawer)
+                      (or (org-log-into-drawer) "LOGBOOK"))
+    (let ((ret
+           (cl-loop
+            for element in-ref (org-element-contents drawer)
+            if (eq (org-element-type element) 'clock)
+            collect element
+            and if remove do (setf element nil))))
+      (org-element-set-contents
+       (cl-remove nil (org-element-contents drawer)))
+      ret)))
+
+(defun org-element-remove (el)
+  "Delete org element EL from its parent."
+  (let ((parent (org-element-property :parent el)))
+    (org-element-set-contents
+     parent
+     (cl-remove el (org-element-contents parent)))))
+
+(defun org-element-clock-start<= (c1 c2)
+  "Compare two clock elements as returned by `org-element-clock-parser'
+and return non-nil if the C1 starts not later than c2."
+  (setq c1 (org-element-property :value c1)
+	c2 (org-element-property :value c2))
+  (cl-loop with val1 with val2
+	   for test in '(:year-start :month-start :day-start :hour-start :minute-start)
+	   do (setq val1 (org-element-property test c1) val2 (org-element-property test c2))
+	   if (< val1 val2)
+	   return t
+	   if (> val1 val2)
+	   return nil
+	   finally return t))
+
+(defun org-merge-subtree-clocks (&optional remove)
+  "Merge clocks in subtree of headline starting at POINT.
+Remove empty logbooks in the sub-tree if REMOVE is non-nil.
+
+Interactively remove empty logbooks when called with prefix-arg \\[universal-argument]."
+  (interactive "P")
+  (let* (b e
+           (headline (org-element-at-point))
+           (type (car headline))
+           (props (cadr headline)))
+    (cl-assert (eq type 'headline)
+               nil
+               "Expected headline got %s" type)
+    (setq b (plist-get props :begin)
+          e (plist-get props :end))
+    (save-restriction
+      (narrow-to-region b e)
+      (let* ((data (org-element-parse-buffer))
+             (clocks (apply #'append
+                            (org-element-map data 'drawer
+                              (lambda (el)
+                                "Remove all clocks from all drawers and collect them in CLOCKS."
+                                (prog1 (org-collect-clock-entries el t)
+                                  (when (and remove
+					                                   (null (org-element-contents el)))
+                                    (org-element-remove el)
+                                    )))))))
+	(setq clocks (sort clocks #'org-element-clock-start<=))
+        (setq headline (org-element-map data 'headline 'identity nil t)) ;; get the first headline within data
+        (or (org-element-map
+                (org-element-contents headline)
+                'drawer ;; check for existing drawer
+              (lambda (el)
+                "Write all clocks to the first LOGBOOK drawer."
+                (when (equal (org-element-property :drawer-name el)
+                             (or (org-log-into-drawer) "LOGBOOK"))
+                  (org-element-set-contents el clocks)
+                  t) ;; indicate that we are done
+                )
+              nil t 'headline) ;; check only first drawer of current headline
+            ;; no drawer yet: add a new one
+            (org-element-set-contents
+             headline
+             (cons (list 'drawer '(:drawer-name "LOGBOOK")
+                         clocks)
+                   (org-element-contents headline))))
+        (kill-region (point-min) (point-max))
+        (insert (org-element-interpret-data data))))))
+
 (defun my-org-refile-cache-rebuild ()
   (org-refile-cache-clear)
   (org-refile-get-targets))
@@ -868,7 +1008,8 @@ When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
 
 (defun my-org-update-updated ()
   (interactive)
-  (when (derived-mode-p 'org-mode)
+  (when (and (derived-mode-p 'org-mode)
+             (not (org-before-first-heading-p)))
     (org-entry-put
      (point) "UPDATED"
      (format-time-string "[%Y-%m-%d %a %H:%M]" (current-time)))))