Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
153 lines (130 sloc) 5.789 kB
;;; helm-org.el --- Helm for org headlines and keywords completion -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto <thierry.volpiatto@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-utils)
(require 'org)
(defgroup helm-org nil
"Org related functions for helm."
:group 'helm)
(defcustom helm-org-headings-fontify nil
"Fontify org buffers before parsing them.
This reflect fontification in helm-buffer when non--nil.
NOTE: This will be slow on large org buffers."
:group 'helm-org
:type 'boolean)
;; Internal
(defvar helm-org-headings--nofilename nil)
;;; Org capture templates
;;
;;
(defvar org-capture-templates)
(defun helm-source-org-capture-templates ()
(helm-build-sync-source "Org Capture Templates:"
:candidates (cl-loop for template in org-capture-templates
collect `(,(nth 1 template) . ,(nth 0 template)))
:action '(("Do capture" . (lambda (template-shortcut)
(org-capture nil template-shortcut))))))
;;; Org headings
;;
;;
(defun helm-org-goto-marker (marker)
(switch-to-buffer (marker-buffer marker))
(goto-char (marker-position marker))
(org-show-context)
(org-show-entry))
(cl-defun helm-source-org-headings-for-files (filenames
&optional (min-depth 1) (max-depth 8))
(helm-build-sync-source "Org Headings"
:candidates (helm-org-get-candidates filenames min-depth max-depth)
:action '(("Go to line" . helm-org-goto-marker)
("Refile to this heading" . helm-org-heading-refile)
("Insert link to this heading"
. helm-org-insert-link-to-heading-at-marker))))
(defun helm-org-insert-link-to-heading-at-marker (marker)
(with-current-buffer (marker-buffer marker)
(let ((heading-name (save-excursion (goto-char (marker-position marker))
(nth 4 (org-heading-components))))
(file-name (buffer-file-name)))
(with-helm-current-buffer
(org-insert-link
file-name (concat "file:" file-name "::*" heading-name))))))
(defun helm-org-heading-refile (marker)
(with-helm-current-buffer
(org-cut-subtree))
(let ((target-level (with-current-buffer (marker-buffer marker)
(goto-char (marker-position marker))
(org-current-level))))
(helm-org-goto-marker marker)
(org-end-of-subtree t t)
(org-paste-subtree (+ target-level 1))))
(defun helm-org-get-candidates (filenames min-depth max-depth)
(apply #'append
(mapcar (lambda (filename)
(helm-get-org-candidates-in-file
filename min-depth max-depth
helm-org-headings-fontify
helm-org-headings--nofilename))
filenames)))
(defun helm-get-org-candidates-in-file (filename min-depth max-depth
&optional fontify nofname)
(with-current-buffer (pcase filename
((pred bufferp) filename)
((pred stringp) (find-file-noselect filename)))
(and fontify (jit-lock-fontify-now))
(let ((match-fn (if fontify 'match-string 'match-string-no-properties)))
(save-excursion
(goto-char (point-min))
(cl-loop with width = (window-width)
while (re-search-forward org-complex-heading-regexp nil t)
if (let ((num-stars (length (match-string-no-properties 1))))
(and (>= num-stars min-depth) (<= num-stars max-depth)))
collect `(,(let ((heading (funcall match-fn 4))
(file (unless nofname
(concat (helm-basename filename) ":")))
(level (length (match-string-no-properties 1))))
(org-format-outline-path
(append (org-get-outline-path t level heading)
(list heading)) width file))
. ,(point-marker)))))))
;;;###autoload
(defun helm-org-agenda-files-headings ()
"Preconfigured helm for org files headings."
(interactive)
(helm :sources (helm-source-org-headings-for-files (org-agenda-files))
:candidate-number-limit 99999
:buffer "*helm org headings*"))
;;;###autoload
(defun helm-org-in-buffer-headings ()
"Preconfigured helm for org buffer headings."
(interactive)
(let ((helm-org-headings--nofilename t))
(helm :sources (helm-source-org-headings-for-files
(list (current-buffer)))
:candidate-number-limit 99999
:buffer "*helm org inbuffer*")))
;;;###autoload
(defun helm-org-capture-templates ()
"Preconfigured helm for org templates."
(interactive)
(helm :sources (helm-source-org-capture-templates)
:candidate-number-limit 99999
:buffer "*helm org capture templates*"))
(provide 'helm-org)
;; Local Variables:
;; byte-compile-warnings: (not cl-functions obsolete)
;; coding: utf-8
;; indent-tabs-mode: nil
;; End:
;;; helm-org.el ends here
Jump to Line
Something went wrong with that request. Please try again.