You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
221 lines
8.2 KiB
221 lines
8.2 KiB
;;; 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)
|
|
|
|
(declare-function org-agenda-switch-to "org-agenda.el")
|
|
|
|
(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)
|
|
|
|
(defcustom helm-org-format-outline-path nil
|
|
"Show all org level as path."
|
|
:group 'helm-org
|
|
:type 'boolean)
|
|
|
|
(defcustom helm-org-show-filename nil
|
|
"Show org filenames in `helm-org-agenda-files-headings' when non--nil.
|
|
Note this have no effect in `helm-org-in-buffer-headings'."
|
|
:group 'helm-org
|
|
:type 'boolean)
|
|
|
|
(defcustom helm-org-headings-min-depth 1
|
|
"Minimum depth of org headings to start with."
|
|
:group 'helm-org
|
|
:type 'integer)
|
|
|
|
(defcustom helm-org-headings-max-depth 8
|
|
"Go down to this maximum depth of org headings."
|
|
:group 'helm-org
|
|
:type 'integer)
|
|
|
|
;;; 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 (cons (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)
|
|
(re-search-backward "^\\*+ " nil t)
|
|
(org-show-entry))
|
|
|
|
(defun helm-source-org-headings-for-files (filenames &optional parents)
|
|
(helm-build-sync-source "Org Headings"
|
|
:candidates filenames ; Start with only filenames.
|
|
:match (lambda (candidate)
|
|
(string-match
|
|
helm-pattern
|
|
(helm-aif (get-text-property 0 'helm-real-display candidate)
|
|
it
|
|
candidate)))
|
|
:candidate-transformer
|
|
;; Now that the helm-window is available proceed to truncation
|
|
;; and other transformations.
|
|
(lambda (candidates)
|
|
(let ((cands (helm-org-get-candidates candidates parents)))
|
|
(if parents (nreverse cands) cands)))
|
|
: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-get-candidates (filenames &optional parents)
|
|
(helm-flatten-list
|
|
(mapcar (lambda (filename)
|
|
(helm-org--get-candidates-in-file
|
|
filename
|
|
helm-org-headings-fontify
|
|
(or parents (null helm-org-show-filename))
|
|
parents))
|
|
filenames)
|
|
t))
|
|
|
|
(defun helm-org--get-candidates-in-file (filename &optional fontify nofname parents)
|
|
(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))
|
|
(search-fn (lambda ()
|
|
(when (or (null parents)
|
|
(org-up-heading-safe))
|
|
(re-search-forward
|
|
org-complex-heading-regexp nil t)))))
|
|
(save-excursion
|
|
(save-restriction
|
|
(widen)
|
|
(unless parents (goto-char (point-min)))
|
|
(cl-loop with width = (window-width (helm-window))
|
|
while (funcall search-fn)
|
|
for all = (funcall match-fn 0)
|
|
for truncated-all = (if (and all (> (length all) width))
|
|
(substring all 0 width) all)
|
|
for level = (length (match-string-no-properties 1))
|
|
for heading = (funcall match-fn 4)
|
|
for file = (unless nofname
|
|
(concat (helm-basename filename) ":"))
|
|
if (and (>= level helm-org-headings-min-depth)
|
|
(<= level helm-org-headings-max-depth))
|
|
collect (cons (propertize
|
|
(if helm-org-format-outline-path
|
|
(org-format-outline-path
|
|
(append (apply #'org-get-outline-path
|
|
(unless parents
|
|
(list t level heading)))
|
|
(list heading))
|
|
width file)
|
|
(if file
|
|
(concat file truncated-all)
|
|
truncated-all))
|
|
'helm-real-display heading)
|
|
(point-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)
|
|
(save-selected-window
|
|
(when (eq major-mode 'org-agenda-mode)
|
|
(org-agenda-switch-to))
|
|
(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)))))
|
|
|
|
;;;###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-show-filename nil))
|
|
(helm :sources (helm-source-org-headings-for-files
|
|
(list (current-buffer)))
|
|
:candidate-number-limit 99999
|
|
:buffer "*helm org inbuffer*")))
|
|
|
|
;;;###autoload
|
|
(defun helm-org-parent-headings ()
|
|
"Preconfigured helm for org headings that are parents of the
|
|
current heading."
|
|
(interactive)
|
|
;; Use a large max-depth to ensure all parents are displayed.
|
|
(let ((helm-org-headings-min-depth 1)
|
|
(helm-org-headings-max-depth 50))
|
|
(helm :sources (helm-source-org-headings-for-files
|
|
(list (current-buffer)) t)
|
|
:candidate-number-limit 99999
|
|
:buffer "*helm org parent headings*")))
|
|
|
|
;;;###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
|