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