changes
[emacs.git] / .emacs.d / elisp / local / ganneff.el
1 ;;; ganneff.el --- Lotsa functiuons and their variables for stuff
2 ;;; ganneffs .emacs wants
3
4 ;; Copyright (C) 2012 Joerg Jaspert
5
6 ;; Filename: ganneff.de
7 ;; Author: Joerg Jaspert <joerg@debian.org>
8
9 ;; The functions in the bh/ namespace are taken from
10 ;; http://doc.norang.ca/org-mode.org.html which has:
11 ;; #+AUTHOR: Bernt Hansen (IRC:Thumper_ on freenode)
12 ;; #+EMAIL: bernt@norang.ca
13 ;; and the following license statement:
14 ;;
15 ;; This document http://doc.norang.ca/org-mode.html and (either in its
16 ;; HTML format or in its Org format) is licensed under the GNU Free
17 ;; Documentation License version 1.3 or later
18 ;; (http://www.gnu.org/copyleft/fdl.html).
19
20 ;; The code examples and css stylesheets are licensed under the GNU
21 ;; General Public License v3 or later
22 ;; (http://www.gnu.org/licenses/gpl.html).
23
24
25 (defgroup ganneff nil
26 "Modify ganneffs settings"
27 :group 'environment)
28
29 (defcustom bh/organization-task-id "d0db0d3c-f22e-42ff-a654-69524ff7cc91"
30 "ID of the organization task"
31 :tag "Organization Task ID"
32 :type 'string
33 :group 'ganneff)
34
35 (defcustom org-my-archive-expiry-days 2
36 "The number of days after which a completed task should be auto-archived.
37 This can be 0 for immediate, or a floating point value."
38 :tag "Archive expiry days"
39 :type 'float
40 :group 'ganneff)
41
42
43 ;;;###autoload
44 (defun my-dired-init ()
45 "Bunch of stuff to run for dired, either immediately or when it's
46 loaded."
47 ;; <add other stuff here>
48 (define-key dired-mode-map [return] 'dired-single-buffer)
49 (define-key dired-mode-map [mouse-1] 'dired-single-buffer-mouse)
50 (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
51 (define-key dired-mode-map "^"
52 (function
53 (lambda nil (interactive) (dired-single-buffer "..")))))
54
55 ;;;###autoload
56 (defun ido-disable-line-trucation () (set (make-local-variable 'truncate-lines) nil))
57
58 ;;;###autoload
59 (defun bh/show-org-agenda ()
60 (interactive)
61 (switch-to-buffer "*Org Agenda*")
62 (delete-other-windows))
63
64 ; Exclude DONE state tasks from refile targets
65 ;;;###autoload
66 (defun bh/verify-refile-target ()
67 "Exclude todo keywords with a done state from refile targets"
68 (not (member (nth 2 (org-heading-components)) org-done-keywords)))
69
70 ;;;###autoload
71 (defmacro bh/agenda-sort-test (fn a b)
72 "Test for agenda sort"
73 `(cond
74 ; if both match leave them unsorted
75 ((and (apply ,fn (list ,a))
76 (apply ,fn (list ,b)))
77 (setq result nil))
78 ; if a matches put a first
79 ((apply ,fn (list ,a))
80 (setq result -1))
81 ; otherwise if b matches put b first
82 ((apply ,fn (list ,b))
83 (setq result 1))
84 ; if none match leave them unsorted
85 (t nil)))
86
87 ;;;###autoload
88 (defmacro bh/agenda-sort-test-num (fn compfn a b)
89 `(cond
90 ((apply ,fn (list ,a))
91 (setq num-a (string-to-number (match-string 1 ,a)))
92 (if (apply ,fn (list ,b))
93 (progn
94 (setq num-b (string-to-number (match-string 1 ,b)))
95 (setq result (if (apply ,compfn (list num-a num-b))
96 -1
97 1)))
98 (setq result -1)))
99 ((apply ,fn (list ,b))
100 (setq result 1))
101 (t nil)))
102
103 ;;;###autoload
104 (defun bh/agenda-sort (a b)
105 "Sorting strategy for agenda items.
106 Late deadlines first, then scheduled, then non-late deadlines"
107 (let (result num-a num-b)
108 (cond
109 ; time specific items are already sorted first by org-agenda-sorting-strategy
110
111 ; non-deadline and non-scheduled items next
112 ((bh/agenda-sort-test 'bh/is-not-scheduled-or-deadline a b))
113
114 ; deadlines for today next
115 ((bh/agenda-sort-test 'bh/is-due-deadline a b))
116
117 ; late deadlines next
118 ((bh/agenda-sort-test-num 'bh/is-late-deadline '< a b))
119
120 ; scheduled items for today next
121 ((bh/agenda-sort-test 'bh/is-scheduled-today a b))
122
123 ; late scheduled items next
124 ((bh/agenda-sort-test-num 'bh/is-scheduled-late '> a b))
125
126 ; pending deadlines last
127 ((bh/agenda-sort-test-num 'bh/is-pending-deadline '< a b))
128
129 ; finally default to unsorted
130 (t (setq result nil)))
131 result))
132
133 ;;;###autoload
134 (defun bh/is-not-scheduled-or-deadline (date-str)
135 (and (not (bh/is-deadline date-str))
136 (not (bh/is-scheduled date-str))))
137
138 ;;;###autoload
139 (defun bh/is-due-deadline (date-str)
140 (string-match "Deadline:" date-str))
141
142 ;;;###autoload
143 (defun bh/is-late-deadline (date-str)
144 (string-match "In *\\(-.*\\)d\.:" date-str))
145
146 ;;;###autoload
147 (defun bh/is-pending-deadline (date-str)
148 (string-match "In \\([^-]*\\)d\.:" date-str))
149
150 ;;;###autoload
151 (defun bh/is-deadline (date-str)
152 (or (bh/is-due-deadline date-str)
153 (bh/is-late-deadline date-str)
154 (bh/is-pending-deadline date-str)))
155
156 ;;;###autoload
157 (defun bh/is-scheduled (date-str)
158 (or (bh/is-scheduled-today date-str)
159 (bh/is-scheduled-late date-str)))
160
161 ;;;###autoload
162 (defun bh/is-scheduled-today (date-str)
163 (string-match "Scheduled:" date-str))
164
165 ;;;###autoload
166 (defun bh/is-scheduled-late (date-str)
167 (string-match "Sched\.\\(.*\\)x:" date-str))
168
169 ;;;###autoload
170 (defun bh/hide-other ()
171 (interactive)
172 (save-excursion
173 (org-back-to-heading 'invisible-ok)
174 (hide-other)
175 (org-cycle)
176 (org-cycle)
177 (org-cycle)))
178
179 ;;;###autoload
180 (defun bh/set-truncate-lines ()
181 "Toggle value of truncate-lines and refresh window display."
182 (interactive)
183 (setq truncate-lines (not truncate-lines))
184 ;; now refresh window display (an idiom from simple.el):
185 (save-excursion
186 (set-window-start (selected-window)
187 (window-start (selected-window)))))
188
189 ;;;###autoload
190 (defun bh/skip-non-archivable-tasks ()
191 "Skip trees that are not available for archiving"
192 (save-restriction
193 (widen)
194 (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
195 ;; Consider only tasks with done todo headings as archivable candidates
196 (if (member (org-get-todo-state) org-done-keywords)
197 (let* ((subtree-end (save-excursion (org-end-of-subtree t)))
198 (daynr (string-to-int (format-time-string "%d" (current-time))))
199 (a-month-ago (* 60 60 24 (+ daynr 1)))
200 (last-month (format-time-string "%Y-%m-" (time-subtract (current-time) (seconds-to-time a-month-ago))))
201 (this-month (format-time-string "%Y-%m-" (current-time)))
202 (subtree-is-current (save-excursion
203 (forward-line 1)
204 (and (< (point) subtree-end)
205 (re-search-forward (concat last-month "\\|" this-month) subtree-end t)))))
206 (if subtree-is-current
207 next-headline ; Has a date in this month or last month, skip it
208 nil)) ; available to archive
209 (or next-headline (point-max))))))
210
211 ;;;###autoload
212 (defun bh/make-org-scratch ()
213 (interactive)
214 (find-file "/tmp/publish/scratch.org")
215 (gnus-make-directory "/tmp/publish"))
216
217 ;;;###autoload
218 (defun bh/switch-to-scratch ()
219 (interactive)
220 (switch-to-buffer "*scratch*"))
221
222 ;;;###autoload
223 (defun bh/org-todo (arg)
224 (interactive "p")
225 (if (equal arg 4)
226 (save-restriction
227 (widen)
228 (org-narrow-to-subtree)
229 (org-show-todo-tree nil))
230 (widen)
231 (org-narrow-to-subtree)
232 (org-show-todo-tree nil)))
233
234 ;;;###autoload
235 (defun bh/widen ()
236 (interactive)
237 (if (equal major-mode 'org-agenda-mode)
238 (org-agenda-remove-restriction-lock)
239 (widen)
240 (org-agenda-remove-restriction-lock)))
241
242 ;;;###autoload
243 (defun bh/insert-inactive-timestamp ()
244 (interactive)
245 (org-insert-time-stamp nil t t nil nil nil))
246
247 ;;;###autoload
248 (defun bh/insert-heading-inactive-timestamp ()
249 (save-excursion
250 (org-return)
251 (org-cycle)
252 (bh/insert-inactive-timestamp)))
253
254 ;; Remove empty LOGBOOK drawers on clock out
255 ;;;###autoload
256 (defun bh/remove-empty-drawer-on-clock-out ()
257 (interactive)
258 (save-excursion
259 (beginning-of-line 0)
260 (org-remove-empty-drawer-at "LOGBOOK" (point))))
261
262 ;;;###autoload
263 (defun bh/prepare-meeting-notes ()
264 "Prepare meeting notes for email
265 Take selected region and convert tabs to spaces, mark TODOs with leading >>>, and copy to kill ring for pasting"
266 (interactive)
267 (let (prefix)
268 (save-excursion
269 (save-restriction
270 (narrow-to-region (region-beginning) (region-end))
271 (untabify (point-min) (point-max))
272 (goto-char (point-min))
273 (while (re-search-forward "^\\( *-\\\) \\(TODO\\|DONE\\): " (point-max) t)
274 (replace-match (concat (make-string (length (match-string 1)) ?>) " " (match-string 2) ": ")))
275 (goto-char (point-min))
276 (kill-ring-save (point-min) (point-max))))))
277
278 ;; Phone capture template handling with BBDB lookup
279 ;; Adapted from code by Gregory J. Grubbs
280 ;;;###autoload
281 (defun bh/phone-call ()
282 "Return name and company info for caller from bbdb lookup"
283 (interactive)
284 (let* (name rec caller)
285 (setq name (completing-read "Who is calling? "
286 (bbdb-hashtable)
287 'bbdb-completion-predicate
288 'confirm))
289 (when (> (length name) 0)
290 ; Something was supplied - look it up in bbdb
291 (setq rec
292 (or (first
293 (or (bbdb-search (bbdb-records) name nil nil)
294 (bbdb-search (bbdb-records) nil name nil)))
295 name)))
296
297 ; Build the bbdb link if we have a bbdb record, otherwise just return the name
298 (setq caller (cond ((and rec (vectorp rec))
299 (let ((name (bbdb-record-name rec))
300 (company (bbdb-record-company rec)))
301 (concat "[[bbdb:"
302 name "]["
303 name "]]"
304 (when company
305 (concat " - " company)))))
306 (rec)
307 (t "NameOfCaller")))
308 (insert caller)))
309
310 ;;;###autoload
311 (defun org-my-archive-done-tasks ()
312 (interactive)
313 (save-excursion
314 (goto-char (point-min))
315 (let ((done-regexp
316 (concat "\\* \\(" (regexp-opt org-done-keywords) "\\) "))
317 (state-regexp
318 (concat "- State \"\\(" (regexp-opt org-done-keywords)
319 "\\)\"\\s-*\\[\\([^]\n]+\\)\\]")))
320 (while (re-search-forward done-regexp nil t)
321 (let ((end (save-excursion
322 (outline-next-heading)
323 (point)))
324 begin)
325 (goto-char (line-beginning-position))
326 (setq begin (point))
327 (if (re-search-forward state-regexp end t)
328 (let* ((time-string (match-string 2))
329 (when-closed (org-parse-time-string time-string)))
330 (if (>= (time-to-number-of-days
331 (time-subtract (current-time)
332 (apply #'encode-time when-closed)))
333 org-my-archive-expiry-days)
334 (org-archive-subtree)))
335 (goto-char end)))))
336 (save-buffer)))
337 (setq safe-local-variable-values (quote ((after-save-hook archive-done-tasks))))
338 ;;;###autoload
339 (defalias 'archive-done-tasks 'org-my-archive-done-tasks)
340
341 ;;;###autoload
342 (defun bh/is-project-p ()
343 "Any task with a todo keyword subtask"
344 (save-restriction
345 (widen)
346 (let ((has-subtask)
347 (subtree-end (save-excursion (org-end-of-subtree t)))
348 (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
349 (save-excursion
350 (forward-line 1)
351 (while (and (not has-subtask)
352 (< (point) subtree-end)
353 (re-search-forward "^\*+ " subtree-end t))
354 (when (member (org-get-todo-state) org-todo-keywords-1)
355 (setq has-subtask t))))
356 (and is-a-task has-subtask))))
357
358 ;;;###autoload
359 (defun bh/is-project-subtree-p ()
360 "Any task with a todo keyword that is in a project subtree.
361 Callers of this function already widen the buffer view."
362 (let ((task (save-excursion (org-back-to-heading 'invisible-ok)
363 (point))))
364 (save-excursion
365 (bh/find-project-task)
366 (if (equal (point) task)
367 nil
368 t))))
369
370 ;;;###autoload
371 (defun bh/is-task-p ()
372 "Any task with a todo keyword and no subtask"
373 (save-restriction
374 (widen)
375 (let ((has-subtask)
376 (subtree-end (save-excursion (org-end-of-subtree t)))
377 (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
378 (save-excursion
379 (forward-line 1)
380 (while (and (not has-subtask)
381 (< (point) subtree-end)
382 (re-search-forward "^\*+ " subtree-end t))
383 (when (member (org-get-todo-state) org-todo-keywords-1)
384 (setq has-subtask t))))
385 (and is-a-task (not has-subtask)))))
386
387 ;;;###autoload
388 (defun bh/is-subproject-p ()
389 "Any task which is a subtask of another project"
390 (let ((is-subproject)
391 (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
392 (save-excursion
393 (while (and (not is-subproject) (org-up-heading-safe))
394 (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
395 (setq is-subproject t))))
396 (and is-a-task is-subproject)))
397
398 ;;;###autoload
399 (defun bh/list-sublevels-for-projects-indented ()
400 "Set org-tags-match-list-sublevels so when restricted to a subtree we list all subtasks.
401 This is normally used by skipping functions where this variable is already local to the agenda."
402 (if (marker-buffer org-agenda-restrict-begin)
403 (setq org-tags-match-list-sublevels 'indented)
404 (setq org-tags-match-list-sublevels nil))
405 nil)
406
407 ;;;###autoload
408 (defun bh/list-sublevels-for-projects ()
409 "Set org-tags-match-list-sublevels so when restricted to a subtree we list all subtasks.
410 This is normally used by skipping functions where this variable is already local to the agenda."
411 (if (marker-buffer org-agenda-restrict-begin)
412 (setq org-tags-match-list-sublevels t)
413 (setq org-tags-match-list-sublevels nil))
414 nil)
415
416 ;;;###autoload
417 (defun bh/skip-non-stuck-projects ()
418 "Skip trees that are not stuck projects"
419 (bh/list-sublevels-for-projects-indented)
420 (save-restriction
421 (widen)
422 (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
423 (if (bh/is-project-p)
424 (let* ((subtree-end (save-excursion (org-end-of-subtree t)))
425 (has-next ))
426 (save-excursion
427 (forward-line 1)
428 (while (and (not has-next) (< (point) subtree-end) (re-search-forward "^\\*+ NEXT " subtree-end t))
429 (unless (member "WAITING" (org-get-tags-at))
430 (setq has-next t))))
431 (if has-next
432 next-headline
433 nil)) ; a stuck project, has subtasks but no next task
434 next-headline))))
435
436 ;;;###autoload
437 (defun bh/skip-non-projects ()
438 "Skip trees that are not projects"
439 (bh/list-sublevels-for-projects-indented)
440 (if (save-excursion (bh/skip-non-stuck-projects))
441 (save-restriction
442 (widen)
443 (let ((subtree-end (save-excursion (org-end-of-subtree t))))
444 (if (bh/is-project-p)
445 nil
446 subtree-end)))
447 (org-end-of-subtree t)))
448
449 ;;;###autoload
450 (defun bh/skip-project-trees-and-habits ()
451 "Skip trees that are projects"
452 (save-restriction
453 (widen)
454 (let ((subtree-end (save-excursion (org-end-of-subtree t))))
455 (cond
456 ((bh/is-project-p)
457 subtree-end)
458 ((org-is-habit-p)
459 subtree-end)
460 (t
461 nil)))))
462
463 ;;;###autoload
464 (defun bh/skip-projects-and-habits-and-single-tasks ()
465 "Skip trees that are projects, tasks that are habits, single non-project tasks"
466 (save-restriction
467 (widen)
468 (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
469 (cond
470 ((org-is-habit-p)
471 next-headline)
472 ((bh/is-project-p)
473 next-headline)
474 ((and (bh/is-task-p) (not (bh/is-project-subtree-p)))
475 next-headline)
476 (t
477 nil)))))
478
479 ;;;###autoload
480 (defun bh/skip-project-tasks-maybe ()
481 "Show tasks related to the current restriction.
482 When restricted to a project, skip project and sub project tasks, habits, NEXT tasks, and loose tasks.
483 When not restricted, skip project and sub-project tasks, habits, and project related tasks."
484 (save-restriction
485 (widen)
486 (let* ((subtree-end (save-excursion (org-end-of-subtree t)))
487 (next-headline (save-excursion (or (outline-next-heading) (point-max))))
488 (limit-to-project (marker-buffer org-agenda-restrict-begin)))
489 (cond
490 ((bh/is-project-p)
491 next-headline)
492 ((org-is-habit-p)
493 subtree-end)
494 ((and (not limit-to-project)
495 (bh/is-project-subtree-p))
496 subtree-end)
497 ((and limit-to-project
498 (bh/is-project-subtree-p)
499 (member (org-get-todo-state) (list "NEXT")))
500 subtree-end)
501 (t
502 nil)))))
503
504 ;;;###autoload
505 (defun bh/skip-projects-and-habits ()
506 "Skip trees that are projects and tasks that are habits"
507 (save-restriction
508 (widen)
509 (let ((subtree-end (save-excursion (org-end-of-subtree t))))
510 (cond
511 ((bh/is-project-p)
512 subtree-end)
513 ((org-is-habit-p)
514 subtree-end)
515 (t
516 nil)))))
517
518 ;;;###autoload
519 (defun bh/skip-non-subprojects ()
520 "Skip trees that are not projects"
521 (let ((next-headline (save-excursion (outline-next-heading))))
522 (if (bh/is-subproject-p)
523 nil
524 next-headline)))
525
526 ; Erase all reminders and rebuilt reminders for today from the agenda
527 ;;;###autoload
528 (defun bh/org-agenda-to-appt ()
529 (interactive)
530 (setq appt-time-msg-list nil)
531 (org-agenda-to-appt))
532
533
534 ;;;###autoload
535 (defun bh/restrict-to-file-or-follow (arg)
536 "Set agenda restriction to 'file or with argument invoke follow mode.
537 I don't use follow mode very often but I restrict to file all the time
538 so change the default 'F' binding in the agenda to allow both"
539 (interactive "p")
540 (if (equal arg 4)
541 (org-agenda-follow-mode)
542 (if (equal major-mode 'org-agenda-mode)
543 (bh/set-agenda-restriction-lock 4)
544 (widen))))
545
546 ;;;###autoload
547 (defun bh/narrow-to-org-subtree ()
548 (widen)
549 (org-narrow-to-subtree)
550 (save-restriction
551 (org-agenda-set-restriction-lock)))
552
553 ;;;###autoload
554 (defun bh/narrow-to-subtree ()
555 (interactive)
556 (if (equal major-mode 'org-agenda-mode)
557 (org-with-point-at (org-get-at-bol 'org-hd-marker)
558 (bh/narrow-to-org-subtree))
559 (bh/narrow-to-org-subtree)))
560
561 ;;;###autoload
562 (defun bh/narrow-up-one-org-level ()
563 (widen)
564 (save-excursion
565 (outline-up-heading 1 'invisible-ok)
566 (bh/narrow-to-org-subtree)))
567
568 ;;;###autoload
569 (defun bh/narrow-up-one-level ()
570 (interactive)
571 (if (equal major-mode 'org-agenda-mode)
572 (org-with-point-at (org-get-at-bol 'org-hd-marker)
573 (bh/narrow-up-one-org-level))
574 (bh/narrow-up-one-org-level)))
575
576 ;;;###autoload
577 (defun bh/narrow-to-org-project ()
578 (widen)
579 (save-excursion
580 (bh/find-project-task)
581 (bh/narrow-to-org-subtree)))
582
583 ;;;###autoload
584 (defun bh/narrow-to-project ()
585 (interactive)
586 (if (equal major-mode 'org-agenda-mode)
587 (org-with-point-at (org-get-at-bol 'org-hd-marker)
588 (bh/narrow-to-org-project))
589 (bh/narrow-to-org-project)))
590
591 ;;;###autoload
592 (defun bh/clock-in-to-next (kw)
593 "Switch a task from TODO to NEXT when clocking in.
594 Skips capture tasks, projects, and subprojects.
595 Switch projects and subprojects from NEXT back to TODO"
596 (when (not (and (boundp 'org-capture-mode) org-capture-mode))
597 (cond
598 ((and (member (org-get-todo-state) (list "TODO"))
599 (bh/is-task-p))
600 "NEXT")
601 ((and (member (org-get-todo-state) (list "NEXT"))
602 (bh/is-project-p))
603 "TODO"))))
604
605 ;;;###autoload
606 (defun bh/find-project-task ()
607 "Move point to the parent (project) task if any"
608 (save-restriction
609 (widen)
610 (let ((parent-task (save-excursion (org-back-to-heading 'invisible-ok) (point))))
611 (while (org-up-heading-safe)
612 (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
613 (setq parent-task (point))))
614 (goto-char parent-task)
615 parent-task)))
616
617 ;;;###autoload
618 (defun bh/punch-in (arg)
619 "Start continuous clocking and set the default task to the
620 selected task. If no task is selected set the Organization task
621 as the default task."
622 (interactive "p")
623 (setq bh/keep-clock-running t)
624 (if (equal major-mode 'org-agenda-mode)
625 ;;
626 ;; We're in the agenda
627 ;;
628 (let* ((marker (org-get-at-bol 'org-hd-marker))
629 (tags (org-with-point-at marker (org-get-tags-at))))
630 (if (and (eq arg 4) tags)
631 (org-agenda-clock-in '(16))
632 (bh/clock-in-organization-task-as-default)))
633 ;;
634 ;; We are not in the agenda
635 ;;
636 (save-restriction
637 (widen)
638 ; Find the tags on the current task
639 (if (and (equal major-mode 'org-mode) (not (org-before-first-heading-p)) (eq arg 4))
640 (org-clock-in '(16))
641 (bh/clock-in-organization-task-as-default)))))
642
643 ;;;###autoload
644 (defun bh/punch-out ()
645 (interactive)
646 (setq bh/keep-clock-running nil)
647 (when (org-clock-is-active)
648 (org-clock-out))
649 (org-agenda-remove-restriction-lock))
650
651 ;;;###autoload
652 (defun bh/clock-in-default-task ()
653 (save-excursion
654 (org-with-point-at org-clock-default-task
655 (org-clock-in))))
656
657 ;;;###autoload
658 (defun bh/clock-in-parent-task ()
659 "Move point to the parent (project) task if any and clock in"
660 (let ((parent-task))
661 (save-excursion
662 (save-restriction
663 (widen)
664 (while (and (not parent-task) (org-up-heading-safe))
665 (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
666 (setq parent-task (point))))
667 (if parent-task
668 (org-with-point-at parent-task
669 (org-clock-in))
670 (when bh/keep-clock-running
671 (bh/clock-in-default-task)))))))
672
673 ;;;###autoload
674 (defun bh/clock-in-organization-task-as-default ()
675 (interactive)
676 (org-with-point-at (org-id-find bh/organization-task-id 'marker)
677 (org-clock-in '(16))))
678
679 ;;;###autoload
680 (defun bh/clock-out-maybe ()
681 (when (and bh/keep-clock-running
682 (not org-clock-clocking-in)
683 (marker-buffer org-clock-default-task)
684 (not org-clock-resolving-clocks-due-to-idleness))
685 (bh/clock-in-parent-task)))
686
687 ;;;###autoload
688 (defun bh/clock-in-last-task (arg)
689 "Clock in the interrupted task if there is one
690 Skip the default task and get the next one.
691 A prefix arg forces clock in of the default task."
692 (interactive "p")
693 (let ((clock-in-to-task
694 (cond
695 ((eq arg 4) org-clock-default-task)
696 ((and (org-clock-is-active)
697 (equal org-clock-default-task (cadr org-clock-history)))
698 (caddr org-clock-history))
699 ((org-clock-is-active) (cadr org-clock-history))
700 ((equal org-clock-default-task (car org-clock-history)) (cadr org-clock-history))
701 (t (car org-clock-history)))))
702 (org-with-point-at clock-in-to-task
703 (org-clock-in nil))))
704
705 ;;;###autoload
706 (defun bh/set-agenda-restriction-lock (arg)
707 "Set restriction lock to current task subtree or file if prefix is specified"
708 (interactive "p")
709 (let* ((pom (bh/get-pom-from-agenda-restriction-or-point))
710 (tags (org-with-point-at pom (org-get-tags-at))))
711 (let ((restriction-type (if (equal arg 4) 'file 'subtree)))
712 (save-restriction
713 (cond
714 ((and (equal major-mode 'org-agenda-mode) pom)
715 (org-with-point-at pom
716 (org-agenda-set-restriction-lock restriction-type)))
717 ((and (equal major-mode 'org-mode) (org-before-first-heading-p))
718 (org-agenda-set-restriction-lock 'file))
719 (pom
720 (org-with-point-at pom
721 (org-agenda-set-restriction-lock restriction-type))))))))
722
723 ;;;###autoload
724 (defun bh/get-pom-from-agenda-restriction-or-point ()
725 (or (org-get-at-bol 'org-hd-marker)
726 (and (marker-position org-agenda-restrict-begin) org-agenda-restrict-begin)
727 (and (equal major-mode 'org-mode) (point))
728 org-clock-marker))
729
730 ;;;###autoload
731 (defun sacha/isearch-yank-current-word ()
732 "Pull current word from buffer into search string."
733 (interactive)
734 (save-excursion
735 (skip-syntax-backward "w_")
736 (isearch-yank-internal
737 (lambda ()
738 (skip-syntax-forward "w_")
739 (point)))))
740
741 ;;;###autoload
742 (defun sacha/search-word-backward ()
743 "Find the previous occurrence of the current word."
744 (interactive)
745 (let ((cur (point)))
746 (skip-syntax-backward "w_")
747 (goto-char
748 (if (re-search-backward (concat "\\_<" (current-word) "\\_>") nil t)
749 (match-beginning 0)
750 cur))))
751
752 ;;;###autoload
753 (defun sacha/search-word-forward ()
754 "Find the next occurrance of the current word."
755 (interactive)
756 (let ((cur (point)))
757 (skip-syntax-forward "w_")
758 (goto-char
759 (if (re-search-forward (concat "\\_<" (current-word) "\\_>") nil t)
760 (match-beginning 0)
761 cur))))
762
763 ;;;###autoload
764 (defun sacha/increase-font-size ()
765 (interactive)
766 (set-face-attribute 'default
767 nil
768 :height
769 (ceiling (* 1.10
770 (face-attribute 'default :height)))))
771 ;;;###autoload
772 (defun sacha/decrease-font-size ()
773 (interactive)
774 (set-face-attribute 'default
775 nil
776 :height
777 (floor (* 0.9
778 (face-attribute 'default :height)))))
779
780 ;;;###autoload
781 (defun epa-dired-mode-hook ()
782 (define-key dired-mode-map ":" 'epa-dired-prefix))
783
784 ;;;###autoload
785 (defun my-c-return ()
786 "When in minibuffer use `icicle-candidate-action', otherwise use `cua-set-rectangle-mark'."
787 (interactive)
788 (if (window-minibuffer-p (selected-window))
789 (call-interactively 'icicle-candidate-action)
790 (call-interactively 'cua-set-rectangle-mark)))
791
792 ;;; define filter. The filter is called on each entry in the agenda.
793 ;;; It defines a regexp to search for two timestamps, gets the start
794 ;;; and end point of the entry and does a regexp search. It also
795 ;;; checks if the category of the entry is in an exclude list and
796 ;;; returns either t or nil to skip or include the entry.
797
798 ;;;###autoload
799 (defun org-mycal-export-limit ()
800 "Limit the export to items that have a date, time and a range. Also exclude certain categories."
801 (setq org-tst-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ... [0-9]\\{2\\}:[0-9]\\{2\\}[^\r\n>]*?\\)>")
802 (setq org-tstr-regexp (concat org-tst-regexp "--?-?" org-tst-regexp))
803 (save-excursion
804 ; get categories
805 (setq mycategory (org-get-category))
806 ; get start and end of tree
807 (org-back-to-heading t)
808 (setq mystart (point))
809 (org-end-of-subtree)
810 (setq myend (point))
811 (goto-char mystart)
812 ; search for timerange
813 (setq myresult (re-search-forward org-tstr-regexp myend t))
814 ; search for categories to exclude
815 (setq mycatp (member mycategory org-export-exclude-category))
816 ; return t if ok, nil when not ok
817 (if (and myresult (not mycatp)) t nil)))
818
819 ;;;###autoload
820 (defun mycal-export-limit ()
821 "Limit the export to items that don't match an unwanted category "
822 (setq mycategory (org-get-category))
823 (not (member mycategory org-export-exclude-category)))
824
825 ;;; activate filter and call export function
826 ;;;###autoload
827 (defun org-mycal-export ()
828 (interactive)
829 (let ((org-icalendar-verify-function 'mycal-export-limit))
830 (org-export-icalendar-combine-agenda-files)))
831
832 ;;;###autoload
833 (defun revert-all-buffers ()
834 "Refreshes all open buffers from their respective files."
835 (interactive)
836 (dolist (buf (buffer-list))
837 (with-current-buffer buf
838 (when (and (buffer-file-name) (not (buffer-modified-p)) (file-exists-p (buffer-file-name)))
839 (revert-buffer t t t) )))
840 (message "Refreshed open files.") )
841
842 ;;;###autoload
843 (defun move-line-up ()
844 "Move up the current line."
845 (interactive)
846 (transpose-lines 1)
847 (forward-line -2)
848 (indent-according-to-mode))
849
850 ;;;###autoload
851 (defun move-line-down ()
852 "Move down the current line."
853 (interactive)
854 (forward-line 1)
855 (transpose-lines 1)
856 (forward-line -1)
857 (indent-according-to-mode))
858
859 ;;;###autoload
860 (defun jj-untabify-buffer ()
861 "Get rid of all tabs"
862 (interactive)
863 (untabify (point-min) (point-max)))
864
865 ;;;###autoload
866 (defun prelude-sudo-edit (&optional arg)
867 "Edit currently visited file as root.
868
869 With a prefix ARG prompt for a file to visit.
870 Will also prompt for a file to visit if current
871 buffer is not visiting a file."
872 (interactive "P")
873 (if (or arg (not buffer-file-name))
874 (find-file (concat "/sudo:root@localhost:"
875 (icicle-find-file-of-content)))
876 (find-alternate-file (concat "/sudo:root@localhost:" buffer-file-name))))
877
878 ;; a great lisp coding hook
879 ;;;###autoload
880 (defun lisp-coding-defaults ()
881 (paredit-mode +1)
882 (rainbow-delimiters-mode +1))
883
884 ;;;###autoload
885 (defun interactive-lisp-coding-defaults ()
886 (paredit-mode +1)
887 (rainbow-delimiters-mode +1)
888 (whitespace-mode -1))
889
890 ;;;###autoload
891 (defun prelude-remove-elc-on-save ()
892 "If you're saving an elisp file, likely the .elc is no longer valid."
893 (make-local-variable 'after-save-hook)
894 (add-hook 'after-save-hook
895 (lambda ()
896 (if (file-exists-p (concat buffer-file-name "c"))
897 (delete-file (concat buffer-file-name "c"))))))
898
899 ;;;###autoload
900 (defun prelude-emacs-lisp-mode-defaults ()
901 (run-hooks 'lisp-coding-hook)
902 (turn-on-eldoc-mode)
903 (prelude-remove-elc-on-save)
904 (rainbow-mode +1)
905 (setq mode-name "EL"))
906
907 ;;;###autoload
908 (defun clean-mode-line ()
909 (interactive)
910 (loop for cleaner in mode-line-cleaner-alist
911 do (let* ((mode (car cleaner))
912 (mode-str (cdr cleaner))
913 (old-mode-str (cdr (assq mode minor-mode-alist))))
914 (when old-mode-str
915 (setcar old-mode-str mode-str))
916 ;; major mode
917 (when (eq mode major-mode)
918 (setq mode-name mode-str)))))
919
920 ;;;###autoload
921 (defun force-backup-of-buffer ()
922 (let ((buffer-backed-up nil))
923 (backup-buffer)))
924
925 ;;;###autoload
926 (defun prelude-kill-other-buffers ()
927 "Kill all buffers but the current one.
928 Doesn't mess with special buffers."
929 (interactive)
930 (-each
931 (->> (buffer-list)
932 (-filter #'buffer-file-name)
933 (--remove (eql (current-buffer) it)))
934 #'kill-buffer))
935
936 (provide 'ganneff)
937
938 ;(setq org-icalendar-verify-function 'org-mycal-export-limit)
939 ;(org-export-icalendar-combine-agenda-files)