jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Change/Fix: (helm-org-ql.el) Wrap in eval-and-compile

Browse source 
This avoids errors when Helm is not installed, and it seems to work
correctly when Helm is installed.  This should be an improvement until
this file is put in its own package.
This commit is contained in:
Adam Porter 2020-03-02 00:53:41 -06:00
parent 11a0466f92
commit 0648196076
1 changed files with 136 additions and 134 deletions
Download patch file Download diff file Expand all files Collapse all files

270
helm-org-ql.el
View file

@ -28,83 +28,85 @@
;;; Code: ;;; Code:
;;;; Requirements (eval-and-compile
(require 'org) (eval-when-compile
;; Require these when compiling, but not necessarily on load.
(require 'org)
(require 'org-ql) (require 'org-ql)
(require 'org-ql-search) (require 'org-ql-search))
;; (require 'helm)
;; (require 'helm-org)
;;;; Compatibility ;;;; Compatibility
;; Declare Helm functions since Helm may not be installed. ;; Declare Helm functions since Helm may not be installed.
(declare-function helm "ext:helm") (declare-function helm "ext:helm")
(declare-function helm-run-after-exit "ext:helm") (declare-function helm-run-after-exit "ext:helm")
(declare-function helm-window "ext:helm-lib") (declare-function helm-window "ext:helm-lib")
(declare-function helm-buffer-get "ext:helm-lib") (declare-function helm-buffer-get "ext:helm-lib")
(declare-function helm-make-source "ext:helm-source") (declare-function helm-make-source "ext:helm-source")
(declare-function helm-org-goto-marker "ext:helm-org") (declare-function helm-org-goto-marker "ext:helm-org")
;; Silence byte-compiler about variables. ;; Silence byte-compiler about variables.
(defvar helm-map) (defvar helm-map)
(defvar helm-pattern) (defvar helm-pattern)
(defvar helm-input-idle-delay) (defvar helm-input-idle-delay)
(when (require 'helm nil 'noerror)
;; Requirements.
(require 'helm-org)
;;;; Variables ;;;; Variables
(defvar helm-org-ql-map (defvar helm-org-ql-map
(let ((map (make-sparse-keymap)) (let ((map (make-sparse-keymap))
(mappings '( (mappings '("C-x C-s" helm-org-ql-save)))
"C-x C-s" helm-org-ql-save (cl-loop for (key fn) on mappings by #'cddr
))) do (define-key map (kbd key) fn))
(cl-loop for (key fn) on mappings by #'cddr (make-composed-keymap map helm-map))
do (define-key map (kbd key) fn)) "Keymap for `helm-org-ql' sessions.
(make-composed-keymap map helm-map))
"Keymap for `helm-org-ql' sessions.
Based on `helm-map'.") Based on `helm-map'.")
(defvar helm-source-org-ql-views (defvar helm-source-org-ql-views
(helm-make-source "Org QL Views" 'helm-source-sync (helm-make-source "Org QL Views" 'helm-source-sync
:candidates (lambda () :candidates (lambda ()
(->> org-ql-views (->> org-ql-views
(-map #'car) (-map #'car)
(-sort #'string<))) (-sort #'string<)))
:action (list (cons "Show view" #'org-ql-view))) :action (list (cons "Show view" #'org-ql-view)))
"Helm source for `org-ql-views'.") "Helm source for `org-ql-views'.")
(defvar-local helm-org-ql-buffers-files nil (defvar-local helm-org-ql-buffers-files nil
"Used for `helm-org-ql-save'.") "Used for `helm-org-ql-save'.")
;;;; Customization ;;;; Customization
(defgroup helm-org-ql nil (defgroup helm-org-ql nil
"Options for `helm-org-ql'." "Options for `helm-org-ql'."
:group 'org-ql) :group 'org-ql)
(defcustom helm-org-ql-reverse-paths t (defcustom helm-org-ql-reverse-paths t
"Whether to reverse Org outline paths in `helm-org-ql' results." "Whether to reverse Org outline paths in `helm-org-ql' results."
:type 'boolean) :type 'boolean)
(defcustom helm-org-ql-input-idle-delay 0.25 (defcustom helm-org-ql-input-idle-delay 0.25
"Seconds to wait after typing stops before running query." "Seconds to wait after typing stops before running query."
:type 'number) :type 'number)
(defcustom helm-org-ql-actions (defcustom helm-org-ql-actions
(list (cons "Show heading in source buffer" 'helm-org-ql-show-marker) (list (cons "Show heading in source buffer" 'helm-org-ql-show-marker)
(cons "Show heading in indirect buffer" 'helm-org-ql-show-marker-indirect)) (cons "Show heading in indirect buffer" 'helm-org-ql-show-marker-indirect))
"Alist of actions for `helm-org-ql' commands." "Alist of actions for `helm-org-ql' commands."
:type '(alist :key-type (string :tag "Description") :type '(alist :key-type (string :tag "Description")
:value-type (function :tag "Command"))) :value-type (function :tag "Command")))
;;;; Commands ;;;; Commands
;;;###autoload ;;;###autoload
(cl-defun helm-org-ql (buffers-files (cl-defun helm-org-ql (buffers-files
&key (boolean 'and) (name "helm-org-ql")) &key (boolean 'and) (name "helm-org-ql"))
"Display results in BUFFERS-FILES for an `org-ql' non-sexp query using Helm. "Display results in BUFFERS-FILES for an `org-ql' non-sexp query using Helm.
Interactively, search the current buffer. Note that this command Interactively, search the current buffer. Note that this command
only accepts non-sexp, \"plain\" queries. only accepts non-sexp, \"plain\" queries.
@ -131,99 +133,99 @@ However, quoted strings remain quoted, so this input:
Is transformed into this query: Is transformed into this query:
(and \"something else\" (tags \"funny\"))" (and \"something else\" (tags \"funny\"))"
(interactive (list (current-buffer))) (interactive (list (current-buffer)))
(let ((boolean (if current-prefix-arg 'or boolean)) (let ((boolean (if current-prefix-arg 'or boolean))
(helm-input-idle-delay helm-org-ql-input-idle-delay)) (helm-input-idle-delay helm-org-ql-input-idle-delay))
(helm :prompt (format "Query (boolean %s): " (-> boolean symbol-name upcase)) (helm :prompt (format "Query (boolean %s): " (-> boolean symbol-name upcase))
:sources (helm-org-ql-source buffers-files :name name)))) :sources (helm-org-ql-source buffers-files :name name))))
;;;###autoload ;;;###autoload
(defun helm-org-ql-agenda-files () (defun helm-org-ql-agenda-files ()
"Search agenda files with `helm-org-ql', which see." "Search agenda files with `helm-org-ql', which see."
(interactive) (interactive)
(helm-org-ql (org-agenda-files) :name "Org Agenda Files")) (helm-org-ql (org-agenda-files) :name "Org Agenda Files"))
;;;###autoload ;;;###autoload
(defun helm-org-ql-org-directory () (defun helm-org-ql-org-directory ()
"Search Org files in `org-directory' with `helm-org-ql'." "Search Org files in `org-directory' with `helm-org-ql'."
(interactive) (interactive)
(helm-org-ql (org-ql-search-directories-files) (helm-org-ql (org-ql-search-directories-files)
:name "Org Directory Files")) :name "Org Directory Files"))
(defun helm-org-ql-show-marker (marker) (defun helm-org-ql-show-marker (marker)
"Show heading at MARKER." "Show heading at MARKER."
(interactive) (interactive)
;; This function is necessary because `helm-org-goto-marker' calls ;; This function is necessary because `helm-org-goto-marker' calls
;; `re-search-backward' to go backward to the start of a heading, ;; `re-search-backward' to go backward to the start of a heading,
;; which, when the marker is already at the desired heading, causes ;; which, when the marker is already at the desired heading, causes
;; it to go to the previous heading. I don't know why it does that. ;; it to go to the previous heading. I don't know why it does that.
(switch-to-buffer (marker-buffer marker)) (switch-to-buffer (marker-buffer marker))
(goto-char marker) (goto-char marker)
(org-show-entry)) (org-show-entry))
(defun helm-org-ql-show-marker-indirect (marker) (defun helm-org-ql-show-marker-indirect (marker)
"Show heading at MARKER with `org-tree-to-indirect-buffer'." "Show heading at MARKER with `org-tree-to-indirect-buffer'."
(interactive) (interactive)
(helm-org-ql-show-marker marker) (helm-org-ql-show-marker marker)
(org-tree-to-indirect-buffer)) (org-tree-to-indirect-buffer))
(defun helm-org-ql-save () (defun helm-org-ql-save ()
"Show `helm-org-ql' search in an `org-ql-search' buffer." "Show `helm-org-ql' search in an `org-ql-search' buffer."
(interactive) (interactive)
(let ((buffers-files (with-current-buffer (helm-buffer-get) (let ((buffers-files (with-current-buffer (helm-buffer-get)
helm-org-ql-buffers-files)) helm-org-ql-buffers-files))
(query (org-ql--plain-query helm-pattern))) (query (org-ql--plain-query helm-pattern)))
(helm-run-after-exit #'org-ql-search buffers-files query))) (helm-run-after-exit #'org-ql-search buffers-files query)))
;;;###autoload ;;;###autoload
(defun helm-org-ql-views () (defun helm-org-ql-views ()
"Show an `org-ql' view selected with Helm." "Show an `org-ql' view selected with Helm."
(interactive) (interactive)
(helm :sources helm-source-org-ql-views)) (helm :sources helm-source-org-ql-views))
;;;; Functions ;;;; Functions
(cl-defun helm-org-ql-source (buffers-files &key (name "helm-org-ql")) (cl-defun helm-org-ql-source (buffers-files &key (name "helm-org-ql"))
"Return Helm source named NAME that searches BUFFERS-FILES with `helm-org-ql'." "Return Helm source named NAME that searches BUFFERS-FILES with `helm-org-ql'."
;; Expansion of `helm-build-sync-source' macro. ;; Expansion of `helm-build-sync-source' macro.
(helm-make-source name 'helm-source-sync (helm-make-source name 'helm-source-sync
:candidates (lambda () :candidates (lambda ()
(let* ((query (org-ql--plain-query helm-pattern)) (let* ((query (org-ql--plain-query helm-pattern))
(window-width (window-width (helm-window)))) (window-width (window-width (helm-window))))
(when query (when query
(with-current-buffer (helm-buffer-get) (with-current-buffer (helm-buffer-get)
(setq helm-org-ql-buffers-files buffers-files)) (setq helm-org-ql-buffers-files buffers-files))
(ignore-errors (ignore-errors
;; Ignore errors that might be caused by partially typed queries. ;; Ignore errors that might be caused by partially typed queries.
(org-ql-select buffers-files query (org-ql-select buffers-files query
:action `(helm-org-ql--heading ,window-width)))))) :action `(helm-org-ql--heading ,window-width))))))
:match #'identity :match #'identity
:fuzzy-match nil :fuzzy-match nil
:multimatch nil :multimatch nil
:nohighlight t :nohighlight t
:volatile t :volatile t
:keymap helm-org-ql-map :keymap helm-org-ql-map
:action helm-org-ql-actions)) :action helm-org-ql-actions))
(defun helm-org-ql--heading (window-width) (defun helm-org-ql--heading (window-width)
"Return string for Helm for heading at point. "Return string for Helm for heading at point.
WINDOW-WIDTH should be the width of the Helm window." WINDOW-WIDTH should be the width of the Helm window."
(font-lock-ensure (point-at-bol) (point-at-eol)) (font-lock-ensure (point-at-bol) (point-at-eol))
;; TODO: It would be better to avoid calculating the prefix and width ;; TODO: It would be better to avoid calculating the prefix and width
;; at each heading, but there's no easy way to do that once in each ;; at each heading, but there's no easy way to do that once in each
;; buffer, unless we manually called `org-ql' in each buffer, which ;; buffer, unless we manually called `org-ql' in each buffer, which
;; I'd prefer not to do. Maybe I should add a feature to `org-ql' to ;; I'd prefer not to do. Maybe I should add a feature to `org-ql' to
;; call a setup function in a buffer before running queries. ;; call a setup function in a buffer before running queries.
(let* ((prefix (concat (buffer-name) ":")) (let* ((prefix (concat (buffer-name) ":"))
(width (- window-width (length prefix))) (width (- window-width (length prefix)))
(heading (org-get-heading t)) (heading (org-get-heading t))
(path (-> (org-get-outline-path) (path (-> (org-get-outline-path)
(org-format-outline-path width nil "") (org-format-outline-path width nil "")
(org-split-string ""))) (org-split-string "")))
(path (if helm-org-ql-reverse-paths (path (if helm-org-ql-reverse-paths
(concat heading "\\" (s-join "\\" (nreverse path))) (concat heading "\\" (s-join "\\" (nreverse path)))
(concat (s-join "/" path) "/" heading)))) (concat (s-join "/" path) "/" heading))))
(cons (concat prefix path) (point-marker)))) (cons (concat prefix path) (point-marker))))))
;;;; Footer ;;;; Footer