-;;; ganneff.el --- Lotsa functiuons and their variables for stuff
-;;; ganneffs .emacs wants
+;;; ganneff1.el --- Some functions and stuff I use
-;; Copyright (C) 2012 Joerg Jaspert
+;;; Copyright (C) 2012.2013 Joerg Jaspert
;; Filename: ganneff.de
;; Author: Joerg Jaspert <joerg@debian.org>
-;; The functions in the bh/ namespace are taken from
-;; http://doc.norang.ca/org-mode.org.html which has:
-;; #+AUTHOR: Bernt Hansen (IRC:Thumper_ on freenode)
-;; #+EMAIL: bernt@norang.ca
-;; and the following license statement:
-;;
-;; This document http://doc.norang.ca/org-mode.html and (either in its
-;; HTML format or in its Org format) is licensed under the GNU Free
-;; Documentation License version 1.3 or later
-;; (http://www.gnu.org/copyleft/fdl.html).
+;;; Commentary:
+;; This is just stuff I use in my emacs configuration.
-;; The code examples and css stylesheets are licensed under the GNU
-;; General Public License v3 or later
-;; (http://www.gnu.org/licenses/gpl.html).
-
-
-(defgroup ganneff nil
- "Modify ganneffs settings"
- :group 'environment)
-
-(defcustom bh/organization-task-id "d0db0d3c-f22e-42ff-a654-69524ff7cc91"
- "ID of the organization task"
- :tag "Organization Task ID"
- :type 'string
- :group 'ganneff)
-
-(defcustom org-my-archive-expiry-days 2
- "The number of days after which a completed task should be auto-archived.
-This can be 0 for immediate, or a floating point value."
- :tag "Archive expiry days"
- :type 'float
- :group 'ganneff)
-
-
-;;;###autoload
-(defun my-dired-init ()
- "Bunch of stuff to run for dired when it's loaded."
- (define-key dired-mode-map [return] 'dired-single-buffer)
- (define-key dired-mode-map [mouse-1] 'dired-single-buffer-mouse)
- (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
- (define-key dired-mode-map "^"
- (function
- (lambda nil (interactive) (dired-single-buffer "..")))))
+;;; Code:
;;;###autoload
(defun ido-disable-line-trucation () (set (make-local-variable 'truncate-lines) nil))
+; match-paren will either jump to the "other" paren or simply insert %
+; #+BEGIN_SRC emacs-lisp tangle:yes
;;;###autoload
-(defun bh/show-org-agenda ()
- (interactive)
- (switch-to-buffer "*Org Agenda*")
- (delete-other-windows))
-
-; Exclude DONE state tasks from refile targets
-;;;###autoload
-(defun bh/verify-refile-target ()
- "Exclude todo keywords with a done state from refile targets"
- (not (member (nth 2 (org-heading-components)) org-done-keywords)))
-
-;;;###autoload
-(defmacro bh/agenda-sort-test (fn a b)
- "Test for agenda sort"
- `(cond
- ; if both match leave them unsorted
- ((and (apply ,fn (list ,a))
- (apply ,fn (list ,b)))
- (setq result nil))
- ; if a matches put a first
- ((apply ,fn (list ,a))
- (setq result -1))
- ; otherwise if b matches put b first
- ((apply ,fn (list ,b))
- (setq result 1))
- ; if none match leave them unsorted
- (t nil)))
-
-;;;###autoload
-(defmacro bh/agenda-sort-test-num (fn compfn a b)
- `(cond
- ((apply ,fn (list ,a))
- (setq num-a (string-to-number (match-string 1 ,a)))
- (if (apply ,fn (list ,b))
- (progn
- (setq num-b (string-to-number (match-string 1 ,b)))
- (setq result (if (apply ,compfn (list num-a num-b))
- -1
- 1)))
- (setq result -1)))
- ((apply ,fn (list ,b))
- (setq result 1))
- (t nil)))
-
-;;;###autoload
-(defun bh/agenda-sort (a b)
- "Sorting strategy for agenda items.
-Late deadlines first, then scheduled, then non-late deadlines"
- (let (result num-a num-b)
- (cond
- ; time specific items are already sorted first by org-agenda-sorting-strategy
-
- ; non-deadline and non-scheduled items next
- ((bh/agenda-sort-test 'bh/is-not-scheduled-or-deadline a b))
-
- ; deadlines for today next
- ((bh/agenda-sort-test 'bh/is-due-deadline a b))
-
- ; late deadlines next
- ((bh/agenda-sort-test-num 'bh/is-late-deadline '< a b))
-
- ; scheduled items for today next
- ((bh/agenda-sort-test 'bh/is-scheduled-today a b))
-
- ; late scheduled items next
- ((bh/agenda-sort-test-num 'bh/is-scheduled-late '> a b))
-
- ; pending deadlines last
- ((bh/agenda-sort-test-num 'bh/is-pending-deadline '< a b))
-
- ; finally default to unsorted
- (t (setq result nil)))
- result))
-
-;;;###autoload
-(defun bh/is-not-scheduled-or-deadline (date-str)
- (and (not (bh/is-deadline date-str))
- (not (bh/is-scheduled date-str))))
-
-;;;###autoload
-(defun bh/is-due-deadline (date-str)
- (string-match "Deadline:" date-str))
-
-;;;###autoload
-(defun bh/is-late-deadline (date-str)
- (string-match "In *\\(-.*\\)d\.:" date-str))
-
-;;;###autoload
-(defun bh/is-pending-deadline (date-str)
- (string-match "In \\([^-]*\\)d\.:" date-str))
-
-;;;###autoload
-(defun bh/is-deadline (date-str)
- (or (bh/is-due-deadline date-str)
- (bh/is-late-deadline date-str)
- (bh/is-pending-deadline date-str)))
-
-;;;###autoload
-(defun bh/is-scheduled (date-str)
- (or (bh/is-scheduled-today date-str)
- (bh/is-scheduled-late date-str)))
-
-;;;###autoload
-(defun bh/is-scheduled-today (date-str)
- (string-match "Scheduled:" date-str))
-
-;;;###autoload
-(defun bh/is-scheduled-late (date-str)
- (string-match "Sched\.\\(.*\\)x:" date-str))
-
-;;;###autoload
-(defun bh/hide-other ()
- (interactive)
- (save-excursion
- (org-back-to-heading 'invisible-ok)
- (hide-other)
- (org-cycle)
- (org-cycle)
- (org-cycle)))
-
-;;;###autoload
-(defun bh/set-truncate-lines ()
- "Toggle value of truncate-lines and refresh window display."
- (interactive)
- (setq truncate-lines (not truncate-lines))
- ;; now refresh window display (an idiom from simple.el):
- (save-excursion
- (set-window-start (selected-window)
- (window-start (selected-window)))))
-
-;;;###autoload
-(defun bh/skip-non-archivable-tasks ()
- "Skip trees that are not available for archiving"
- (save-restriction
- (widen)
- (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
- ;; Consider only tasks with done todo headings as archivable candidates
- (if (member (org-get-todo-state) org-done-keywords)
- (let* ((subtree-end (save-excursion (org-end-of-subtree t)))
- (daynr (string-to-int (format-time-string "%d" (current-time))))
- (a-month-ago (* 60 60 24 (+ daynr 1)))
- (last-month (format-time-string "%Y-%m-" (time-subtract (current-time) (seconds-to-time a-month-ago))))
- (this-month (format-time-string "%Y-%m-" (current-time)))
- (subtree-is-current (save-excursion
- (forward-line 1)
- (and (< (point) subtree-end)
- (re-search-forward (concat last-month "\\|" this-month) subtree-end t)))))
- (if subtree-is-current
- next-headline ; Has a date in this month or last month, skip it
- nil)) ; available to archive
- (or next-headline (point-max))))))
-
-;;;###autoload
-(defun bh/make-org-scratch ()
- (interactive)
- (find-file "/tmp/publish/scratch.org")
- (gnus-make-directory "/tmp/publish"))
-
-;;;###autoload
-(defun bh/switch-to-scratch ()
- (interactive)
- (switch-to-buffer "*scratch*"))
-
-;;;###autoload
-(defun bh/org-todo (arg)
- (interactive "p")
- (if (equal arg 4)
- (save-restriction
- (widen)
- (org-narrow-to-subtree)
- (org-show-todo-tree nil))
- (widen)
- (org-narrow-to-subtree)
- (org-show-todo-tree nil)))
-
-;;;###autoload
-(defun bh/widen ()
- (interactive)
- (if (equal major-mode 'org-agenda-mode)
- (org-agenda-remove-restriction-lock)
- (widen)
- (org-agenda-remove-restriction-lock)))
-
-;;;###autoload
-(defun bh/insert-inactive-timestamp ()
- (interactive)
- (org-insert-time-stamp nil t t nil nil nil))
-
-;;;###autoload
-(defun bh/insert-heading-inactive-timestamp ()
- (save-excursion
- (org-return)
- (org-cycle)
- (bh/insert-inactive-timestamp)))
-
-;; Remove empty LOGBOOK drawers on clock out
-;;;###autoload
-(defun bh/remove-empty-drawer-on-clock-out ()
- (interactive)
- (save-excursion
- (beginning-of-line 0)
- (org-remove-empty-drawer-at "LOGBOOK" (point))))
-
-;;;###autoload
-(defun bh/prepare-meeting-notes ()
- "Prepare meeting notes for email
- Take selected region and convert tabs to spaces, mark TODOs with leading >>>, and copy to kill ring for pasting"
- (interactive)
- (let (prefix)
- (save-excursion
- (save-restriction
- (narrow-to-region (region-beginning) (region-end))
- (untabify (point-min) (point-max))
- (goto-char (point-min))
- (while (re-search-forward "^\\( *-\\\) \\(TODO\\|DONE\\): " (point-max) t)
- (replace-match (concat (make-string (length (match-string 1)) ?>) " " (match-string 2) ": ")))
- (goto-char (point-min))
- (kill-ring-save (point-min) (point-max))))))
-
-;; Phone capture template handling with BBDB lookup
-;; Adapted from code by Gregory J. Grubbs
-;;;###autoload
-(defun bh/phone-call ()
- "Return name and company info for caller from bbdb lookup"
- (interactive)
- (let* (name rec caller)
- (setq name (completing-read "Who is calling? "
- (bbdb-hashtable)
- 'bbdb-completion-predicate
- 'confirm))
- (when (> (length name) 0)
-; Something was supplied - look it up in bbdb
- (setq rec
- (or (first
- (or (bbdb-search (bbdb-records) name nil nil)
- (bbdb-search (bbdb-records) nil name nil)))
- name)))
-
-; Build the bbdb link if we have a bbdb record, otherwise just return the name
- (setq caller (cond ((and rec (vectorp rec))
- (let ((name (bbdb-record-name rec))
- (company (bbdb-record-company rec)))
- (concat "[[bbdb:"
- name "]["
- name "]]"
- (when company
- (concat " - " company)))))
- (rec)
- (t "NameOfCaller")))
- (insert caller)))
-
-;;;###autoload
-(defun org-my-archive-done-tasks ()
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (let ((done-regexp
- (concat "\\* \\(" (regexp-opt org-done-keywords) "\\) "))
- (state-regexp
- (concat "- State \"\\(" (regexp-opt org-done-keywords)
- "\\)\"\\s-*\\[\\([^]\n]+\\)\\]")))
- (while (re-search-forward done-regexp nil t)
- (let ((end (save-excursion
- (outline-next-heading)
- (point)))
- begin)
- (goto-char (line-beginning-position))
- (setq begin (point))
- (if (re-search-forward state-regexp end t)
- (let* ((time-string (match-string 2))
- (when-closed (org-parse-time-string time-string)))
- (if (>= (time-to-number-of-days
- (time-subtract (current-time)
- (apply #'encode-time when-closed)))
- org-my-archive-expiry-days)
- (org-archive-subtree)))
- (goto-char end)))))
- (save-buffer)))
-(setq safe-local-variable-values (quote ((after-save-hook archive-done-tasks))))
-;;;###autoload
-(defalias 'archive-done-tasks 'org-my-archive-done-tasks)
-
-;;;###autoload
-(defun bh/is-project-p ()
- "Any task with a todo keyword subtask"
- (save-restriction
- (widen)
- (let ((has-subtask)
- (subtree-end (save-excursion (org-end-of-subtree t)))
- (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
- (save-excursion
- (forward-line 1)
- (while (and (not has-subtask)
- (< (point) subtree-end)
- (re-search-forward "^\*+ " subtree-end t))
- (when (member (org-get-todo-state) org-todo-keywords-1)
- (setq has-subtask t))))
- (and is-a-task has-subtask))))
-
-;;;###autoload
-(defun bh/is-project-subtree-p ()
- "Any task with a todo keyword that is in a project subtree.
-Callers of this function already widen the buffer view."
- (let ((task (save-excursion (org-back-to-heading 'invisible-ok)
- (point))))
- (save-excursion
- (bh/find-project-task)
- (if (equal (point) task)
- nil
- t))))
-
-;;;###autoload
-(defun bh/is-task-p ()
- "Any task with a todo keyword and no subtask"
- (save-restriction
- (widen)
- (let ((has-subtask)
- (subtree-end (save-excursion (org-end-of-subtree t)))
- (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
- (save-excursion
- (forward-line 1)
- (while (and (not has-subtask)
- (< (point) subtree-end)
- (re-search-forward "^\*+ " subtree-end t))
- (when (member (org-get-todo-state) org-todo-keywords-1)
- (setq has-subtask t))))
- (and is-a-task (not has-subtask)))))
-
-;;;###autoload
-(defun bh/is-subproject-p ()
- "Any task which is a subtask of another project"
- (let ((is-subproject)
- (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
- (save-excursion
- (while (and (not is-subproject) (org-up-heading-safe))
- (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
- (setq is-subproject t))))
- (and is-a-task is-subproject)))
-
-;;;###autoload
-(defun bh/list-sublevels-for-projects-indented ()
- "Set org-tags-match-list-sublevels so when restricted to a subtree we list all subtasks.
- This is normally used by skipping functions where this variable is already local to the agenda."
- (if (marker-buffer org-agenda-restrict-begin)
- (setq org-tags-match-list-sublevels 'indented)
- (setq org-tags-match-list-sublevels nil))
- nil)
-
-;;;###autoload
-(defun bh/list-sublevels-for-projects ()
- "Set org-tags-match-list-sublevels so when restricted to a subtree we list all subtasks.
- This is normally used by skipping functions where this variable is already local to the agenda."
- (if (marker-buffer org-agenda-restrict-begin)
- (setq org-tags-match-list-sublevels t)
- (setq org-tags-match-list-sublevels nil))
- nil)
-
-;;;###autoload
-(defun bh/skip-non-stuck-projects ()
- "Skip trees that are not stuck projects"
- (bh/list-sublevels-for-projects-indented)
- (save-restriction
- (widen)
- (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
- (if (bh/is-project-p)
- (let* ((subtree-end (save-excursion (org-end-of-subtree t)))
- (has-next ))
- (save-excursion
- (forward-line 1)
- (while (and (not has-next) (< (point) subtree-end) (re-search-forward "^\\*+ NEXT " subtree-end t))
- (unless (member "WAITING" (org-get-tags-at))
- (setq has-next t))))
- (if has-next
- next-headline
- nil)) ; a stuck project, has subtasks but no next task
- next-headline))))
-
-;;;###autoload
-(defun bh/skip-non-projects ()
- "Skip trees that are not projects"
- (bh/list-sublevels-for-projects-indented)
- (if (save-excursion (bh/skip-non-stuck-projects))
- (save-restriction
- (widen)
- (let ((subtree-end (save-excursion (org-end-of-subtree t))))
- (if (bh/is-project-p)
- nil
- subtree-end)))
- (org-end-of-subtree t)))
-
-;;;###autoload
-(defun bh/skip-project-trees-and-habits ()
- "Skip trees that are projects"
- (save-restriction
- (widen)
- (let ((subtree-end (save-excursion (org-end-of-subtree t))))
- (cond
- ((bh/is-project-p)
- subtree-end)
- ((org-is-habit-p)
- subtree-end)
- (t
- nil)))))
-
-;;;###autoload
-(defun bh/skip-projects-and-habits-and-single-tasks ()
- "Skip trees that are projects, tasks that are habits, single non-project tasks"
- (save-restriction
- (widen)
- (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
- (cond
- ((org-is-habit-p)
- next-headline)
- ((bh/is-project-p)
- next-headline)
- ((and (bh/is-task-p) (not (bh/is-project-subtree-p)))
- next-headline)
- (t
- nil)))))
-
-;;;###autoload
-(defun bh/skip-project-tasks-maybe ()
- "Show tasks related to the current restriction.
-When restricted to a project, skip project and sub project tasks, habits, NEXT tasks, and loose tasks.
-When not restricted, skip project and sub-project tasks, habits, and project related tasks."
- (save-restriction
- (widen)
- (let* ((subtree-end (save-excursion (org-end-of-subtree t)))
- (next-headline (save-excursion (or (outline-next-heading) (point-max))))
- (limit-to-project (marker-buffer org-agenda-restrict-begin)))
- (cond
- ((bh/is-project-p)
- next-headline)
- ((org-is-habit-p)
- subtree-end)
- ((and (not limit-to-project)
- (bh/is-project-subtree-p))
- subtree-end)
- ((and limit-to-project
- (bh/is-project-subtree-p)
- (member (org-get-todo-state) (list "NEXT")))
- subtree-end)
- (t
- nil)))))
-
-;;;###autoload
-(defun bh/skip-projects-and-habits ()
- "Skip trees that are projects and tasks that are habits"
- (save-restriction
- (widen)
- (let ((subtree-end (save-excursion (org-end-of-subtree t))))
- (cond
- ((bh/is-project-p)
- subtree-end)
- ((org-is-habit-p)
- subtree-end)
- (t
- nil)))))
-
-;;;###autoload
-(defun bh/skip-non-subprojects ()
- "Skip trees that are not projects"
- (let ((next-headline (save-excursion (outline-next-heading))))
- (if (bh/is-subproject-p)
- nil
- next-headline)))
-
-; Erase all reminders and rebuilt reminders for today from the agenda
-;;;###autoload
-(defun bh/org-agenda-to-appt ()
- (interactive)
- (setq appt-time-msg-list nil)
- (org-agenda-to-appt))
-
-
-;;;###autoload
-(defun bh/restrict-to-file-or-follow (arg)
- "Set agenda restriction to 'file or with argument invoke follow mode.
-I don't use follow mode very often but I restrict to file all the time
-so change the default 'F' binding in the agenda to allow both"
+(defun match-paren (arg)
+ "Go to the matching parenthesis if on parenthesis otherwise insert %."
(interactive "p")
- (if (equal arg 4)
- (org-agenda-follow-mode)
- (if (equal major-mode 'org-agenda-mode)
- (bh/set-agenda-restriction-lock 4)
- (widen))))
-
-;;;###autoload
-(defun bh/narrow-to-org-subtree ()
- (widen)
- (org-narrow-to-subtree)
- (save-restriction
- (org-agenda-set-restriction-lock)))
-
-;;;###autoload
-(defun bh/narrow-to-subtree ()
- (interactive)
- (if (equal major-mode 'org-agenda-mode)
- (org-with-point-at (org-get-at-bol 'org-hd-marker)
- (bh/narrow-to-org-subtree))
- (bh/narrow-to-org-subtree)))
-
-;;;###autoload
-(defun bh/narrow-up-one-org-level ()
- (widen)
- (save-excursion
- (outline-up-heading 1 'invisible-ok)
- (bh/narrow-to-org-subtree)))
-
-;;;###autoload
-(defun bh/narrow-up-one-level ()
- (interactive)
- (if (equal major-mode 'org-agenda-mode)
- (org-with-point-at (org-get-at-bol 'org-hd-marker)
- (bh/narrow-up-one-org-level))
- (bh/narrow-up-one-org-level)))
-
-;;;###autoload
-(defun bh/narrow-to-org-project ()
- (widen)
- (save-excursion
- (bh/find-project-task)
- (bh/narrow-to-org-subtree)))
-
-;;;###autoload
-(defun bh/narrow-to-project ()
- (interactive)
- (if (equal major-mode 'org-agenda-mode)
- (org-with-point-at (org-get-at-bol 'org-hd-marker)
- (bh/narrow-to-org-project))
- (bh/narrow-to-org-project)))
-
-;;;###autoload
-(defun bh/clock-in-to-next (kw)
- "Switch a task from TODO to NEXT when clocking in.
- Skips capture tasks, projects, and subprojects.
- Switch projects and subprojects from NEXT back to TODO"
- (when (not (and (boundp 'org-capture-mode) org-capture-mode))
- (cond
- ((and (member (org-get-todo-state) (list "TODO"))
- (bh/is-task-p))
- "NEXT")
- ((and (member (org-get-todo-state) (list "NEXT"))
- (bh/is-project-p))
- "TODO"))))
-
-;;;###autoload
-(defun bh/find-project-task ()
- "Move point to the parent (project) task if any"
- (save-restriction
- (widen)
- (let ((parent-task (save-excursion (org-back-to-heading 'invisible-ok) (point))))
- (while (org-up-heading-safe)
- (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
- (setq parent-task (point))))
- (goto-char parent-task)
- parent-task)))
-
-;;;###autoload
-(defun bh/punch-in (arg)
- "Start continuous clocking and set the default task to the
- selected task. If no task is selected set the Organization task
- as the default task."
- (interactive "p")
- (setq bh/keep-clock-running t)
- (if (equal major-mode 'org-agenda-mode)
- ;;
- ;; We're in the agenda
- ;;
- (let* ((marker (org-get-at-bol 'org-hd-marker))
- (tags (org-with-point-at marker (org-get-tags-at))))
- (if (and (eq arg 4) tags)
- (org-agenda-clock-in '(16))
- (bh/clock-in-organization-task-as-default)))
- ;;
- ;; We are not in the agenda
- ;;
- (save-restriction
- (widen)
-; Find the tags on the current task
- (if (and (equal major-mode 'org-mode) (not (org-before-first-heading-p)) (eq arg 4))
- (org-clock-in '(16))
- (bh/clock-in-organization-task-as-default)))))
-
-;;;###autoload
-(defun bh/punch-out ()
- (interactive)
- (setq bh/keep-clock-running nil)
- (when (org-clock-is-active)
- (org-clock-out))
- (org-agenda-remove-restriction-lock))
-
-;;;###autoload
-(defun bh/clock-in-default-task ()
- (save-excursion
- (org-with-point-at org-clock-default-task
- (org-clock-in))))
-
-;;;###autoload
-(defun bh/clock-in-parent-task ()
- "Move point to the parent (project) task if any and clock in"
- (let ((parent-task))
- (save-excursion
- (save-restriction
- (widen)
- (while (and (not parent-task) (org-up-heading-safe))
- (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
- (setq parent-task (point))))
- (if parent-task
- (org-with-point-at parent-task
- (org-clock-in))
- (when bh/keep-clock-running
- (bh/clock-in-default-task)))))))
-
-;;;###autoload
-(defun bh/clock-in-organization-task-as-default ()
- (interactive)
- (org-with-point-at (org-id-find bh/organization-task-id 'marker)
- (org-clock-in '(16))))
-
-;;;###autoload
-(defun bh/clock-out-maybe ()
- (when (and bh/keep-clock-running
- (not org-clock-clocking-in)
- (marker-buffer org-clock-default-task)
- (not org-clock-resolving-clocks-due-to-idleness))
- (bh/clock-in-parent-task)))
-
-;;;###autoload
-(defun bh/clock-in-last-task (arg)
- "Clock in the interrupted task if there is one
- Skip the default task and get the next one.
- A prefix arg forces clock in of the default task."
- (interactive "p")
- (let ((clock-in-to-task
- (cond
- ((eq arg 4) org-clock-default-task)
- ((and (org-clock-is-active)
- (equal org-clock-default-task (cadr org-clock-history)))
- (caddr org-clock-history))
- ((org-clock-is-active) (cadr org-clock-history))
- ((equal org-clock-default-task (car org-clock-history)) (cadr org-clock-history))
- (t (car org-clock-history)))))
- (org-with-point-at clock-in-to-task
- (org-clock-in nil))))
-
-;;;###autoload
-(defun bh/set-agenda-restriction-lock (arg)
- "Set restriction lock to current task subtree or file if prefix is specified"
- (interactive "p")
- (let* ((pom (bh/get-pom-from-agenda-restriction-or-point))
- (tags (org-with-point-at pom (org-get-tags-at))))
- (let ((restriction-type (if (equal arg 4) 'file 'subtree)))
- (save-restriction
- (cond
- ((and (equal major-mode 'org-agenda-mode) pom)
- (org-with-point-at pom
- (org-agenda-set-restriction-lock restriction-type)))
- ((and (equal major-mode 'org-mode) (org-before-first-heading-p))
- (org-agenda-set-restriction-lock 'file))
- (pom
- (org-with-point-at pom
- (org-agenda-set-restriction-lock restriction-type))))))))
-
-;;;###autoload
-(defun bh/get-pom-from-agenda-restriction-or-point ()
- (or (org-get-at-bol 'org-hd-marker)
- (and (marker-position org-agenda-restrict-begin) org-agenda-restrict-begin)
- (and (equal major-mode 'org-mode) (point))
- org-clock-marker))
+ (cond ((looking-at "\\s\(") (forward-list 1) (backward-char 1))
+ ((looking-at "\\s\)") (forward-char 1) (backward-list 1))
+ (t (self-insert-command (or arg 1)))))
;;;###autoload
(defun sacha/isearch-yank-current-word ()
;;; checks if the category of the entry is in an exclude list and
;;; returns either t or nil to skip or include the entry.
-;;;###autoload
-(defun org-mycal-export-limit ()
- "Limit the export to items that have a date, time and a range. Also exclude certain categories."
- (setq org-tst-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ... [0-9]\\{2\\}:[0-9]\\{2\\}[^\r\n>]*?\\)>")
- (setq org-tstr-regexp (concat org-tst-regexp "--?-?" org-tst-regexp))
- (save-excursion
- ; get categories
- (setq mycategory (org-get-category))
- ; get start and end of tree
- (org-back-to-heading t)
- (setq mystart (point))
- (org-end-of-subtree)
- (setq myend (point))
- (goto-char mystart)
- ; search for timerange
- (setq myresult (re-search-forward org-tstr-regexp myend t))
- ; search for categories to exclude
- (setq mycatp (member mycategory org-export-exclude-category))
- ; return t if ok, nil when not ok
- (if (and myresult (not mycatp)) t nil)))
-
-;;;###autoload
-(defun mycal-export-limit ()
- "Limit the export to items that don't match an unwanted category "
- (setq mycategory (org-get-category))
- (not (member mycategory org-export-exclude-category)))
-
-;;; activate filter and call export function
-;;;###autoload
-(defun org-mycal-export ()
- (interactive)
- (let ((org-icalendar-verify-function 'mycal-export-limit))
- (org-export-icalendar-combine-agenda-files)))
-
;;;###autoload
(defun revert-all-buffers ()
"Refreshes all open buffers from their respective files."
(interactive)
(just-one-space -1))
-(provide 'ganneff)
-
;(setq org-icalendar-verify-function 'org-mycal-export-limit)
;(org-export-icalendar-combine-agenda-files)
+
+
+;;;###autoload
+(defun font-lock-comment-annotations ()
+ "Highlight a bunch of well known comment annotations.
+
+This functions should be added to the hooks of major modes for programming."
+ (font-lock-add-keywords
+ nil '(("\\<\\(FIX\\(ME\\)?\\|TODO\\|OPTIMIZE\\|HACK\\|REFACTOR\\):"
+ 1 font-lock-warning-face t))))
+
+;;;###autoload
+(defun jj-open-shell ()
+ "Open a shell in the directory of the current buffer file"
+
+ (interactive)
+ (when buffer-file-name
+ (setenv "ZSTARTDIR" (file-truename buffer-file-name)))
+ (when dired-directory
+ (setenv "ZSTARTDIR" (concat (file-truename dired-directory) "/dired")))
+ (start-process "open-shell" nil "/usr/bin/x-terminal-emulator"))
+
+; From: http://www.blogbyben.com/2013/09/emacs-function-humanifying-urls.html,
+; licensed CC BY 3.0. Author: Ben Simon
+;;;###autoload
+(defun url-humanify ()
+ "Take the URL at point and make it human readable."
+ (interactive)
+ (let* ((area (bounds-of-thing-at-point 'url))
+ (num-params (count-matches "&" (car area) (cdr area)))
+ (i 0))
+ (beginning-of-thing 'url)
+ (when (search-forward "?" (cdr area) t nil)
+ (insert "\n ")
+ (while (< i num-params)
+ (search-forward "&" nil t nil)
+ (insert "\n ")
+ (save-excursion
+ (previous-line)
+ (beginning-of-line)
+ (let ((start (search-forward "="))
+ (end (search-forward "&")))
+ (url-decode-region start end)))
+ (setq i (+ i 1))))))
+
+; From: http://www.blogbyben.com/2013/09/emacs-function-humanifying-urls.html,
+; licensed CC BY 3.0. Author: Ben Simon
+;;;###autoload
+(defun url-decode-region (start end)
+ "Replace a region with the same contents, only URL decoded."
+ (interactive "r")
+ (let ((text (url-unhex-string (buffer-substring start end))))
+ (delete-region start end)
+ (insert text)))
+
+;;;###autoload
+(defun align-code (beg end &optional arg)
+ (interactive "rP")
+ (if (null arg)
+ (align beg end)
+ (let ((end-mark (copy-marker end)))
+ (indent-region beg end-mark nil)
+ (align beg end-mark))))
+
+;;;###autoload
+ (defun insert-date (prefix)
+ "Insert the current date. With prefix-argument, use ISO format. With
+ two prefix arguments, write out the day and month name."
+ (interactive "P")
+ (let ((format (cond
+ ((not prefix) "%d.%m.%Y")
+ ((equal prefix '(4)) "%Y-%m-%d")
+ ((equal prefix '(16)) "%A, %d. %B %Y")
+ ((equal prefix '(64)) "%Y-%m-%dT%H:%M:%S.%3N")
+ ))
+ (system-time-locale "de_DE"))
+ (insert (format-time-string format))))
+
+;;;###autoload
+(defun occur-dwim ()
+ "Call `occur' with a sane default."
+ (interactive)
+ (push (if (region-active-p)
+ (buffer-substring-no-properties
+ (region-beginning)
+ (region-end))
+ (thing-at-point 'symbol))
+ regexp-history)
+ (call-interactively 'occur))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; change case of letters ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; http://ergoemacs.org/emacs/modernization_upcase-word.html
+;;;###autoload
+(defun toggle-letter-case ()
+ "Toggle the letter case of current word or text selection.
+Toggles between: “all lower”, “Init Caps”, “ALL CAPS”."
+ (interactive)
+ (let (p1 p2 (deactivate-mark nil) (case-fold-search nil))
+ (if (region-active-p)
+ (setq p1 (region-beginning) p2 (region-end))
+ (let ((bds (bounds-of-thing-at-point 'word) ) )
+ (setq p1 (car bds) p2 (cdr bds)) ) )
+
+ (when (not (eq last-command this-command))
+ (save-excursion
+ (goto-char p1)
+ (cond
+ ((looking-at "[[:lower:]][[:lower:]]") (put this-command 'state "all lower"))
+ ((looking-at "[[:upper:]][[:upper:]]") (put this-command 'state "all caps") )
+ ((looking-at "[[:upper:]][[:lower:]]") (put this-command 'state "init caps") )
+ ((looking-at "[[:lower:]]") (put this-command 'state "all lower"))
+ ((looking-at "[[:upper:]]") (put this-command 'state "all caps") )
+ (t (put this-command 'state "all lower") ) ) )
+ )
+
+ (cond
+ ((string= "all lower" (get this-command 'state))
+ (upcase-initials-region p1 p2) (put this-command 'state "init caps"))
+ ((string= "init caps" (get this-command 'state))
+ (upcase-region p1 p2) (put this-command 'state "all caps"))
+ ((string= "all caps" (get this-command 'state))
+ (downcase-region p1 p2) (put this-command 'state "all lower")) )
+ )
+ )
+
+
+(provide 'ganneff)
+
+;;; ganneff.el ends here
projects / emacs.git / blobdiff