Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use dynamic completion #10

Merged
merged 8 commits into from
Dec 1, 2019
Merged

Use dynamic completion #10

Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
fd07328
Use dynamic completion
Nov 28, 2019
9128377
No need to filter with helm-pattern
Nov 28, 2019
e3f1dd2
Sort candidates
Nov 28, 2019
14d8188
Fix helm-realvalue
Nov 29, 2019
71833a8
Don't bind candidate-number-limit to hight value
Nov 29, 2019
a4d8278
Remove requires-pattern
Nov 29, 2019
8e875b0
Use a cache as local variable
Nov 29, 2019
5311845
Use buffer-chars-modified-tick to not update when
Nov 29, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
257 changes: 102 additions & 155 deletions helm-org.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -202,95 +202,32 @@ Note: [1] A separator can be a comma, a colon i.e. [,:] or a space.
map)
"Keymap for `helm-source-org-headings-for-files'.")

(defclass helm-org-headings-class (helm-source-sync)
((parents
:initarg :parents
:initform nil
:custom boolean)
(match :initform
(lambda (candidate)
(string-match
helm-pattern
(helm-aif (get-text-property 0 'helm-real-display candidate)
it
candidate))))
(help-message :initform 'helm-org-headings-help-message)
(action :initform 'helm-org-headings-actions)
(keymap :initform 'helm-org-headings-map)
(group :initform 'helm-org)))

(defmethod helm--setup-source :after ((source helm-org-headings-class))
(let ((parents (slot-value source 'parents)))
(setf (slot-value source 'candidate-transformer)
(lambda (candidates)
(let ((cands (helm-org-get-candidates candidates parents)))
(if parents (nreverse cands) cands))))))

(defun helm-source-org-headings-for-files (filenames &optional parents)
"Build source for org headings in files FILENAMES.
When PARENTS is specified, bild source for heading that are parents of
current heading."
(helm-make-source "Org Headings" 'helm-org-headings-class
:filtered-candidate-transformer 'helm-org-startup-visibility
:parents parents
:candidates filenames))

(defun helm-org-startup-visibility (candidates _source)
"Indent headings and hide leading stars displayed in the helm buffer.
If `org-startup-indented' and `org-hide-leading-stars' are nil, do
nothing to CANDIDATES."
(cl-loop for i in candidates
collect
;; Transformation is not needed if these variables are t.
(if (or helm-org-show-filename helm-org-format-outline-path)
(cons
(car i) (cdr i))
(cons
(if helm-org-headings-fontify
(when (string-match "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)" (car i))
(replace-match "\\1\\2\\3" t nil (car i)))
(when (string-match "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)" (car i))
(let ((foreground (org-find-invisible-foreground)))
(with-helm-current-buffer
(cond
;; org-startup-indented is t, and org-hide-leading-stars is t
;; Or: #+STARTUP: indent hidestars
((and org-startup-indented org-hide-leading-stars)
(with-helm-buffer
(require 'org-indent)
(org-indent-mode 1)
(replace-match
(format "%s\\2\\3"
(propertize (replace-match "\\1" t nil (car i))
'face `(:foreground ,foreground)))
t nil (car i))))
;; org-startup-indented is nil, org-hide-leading-stars is t
;; Or: #+STARTUP: noindent hidestars
((and (not org-startup-indented) org-hide-leading-stars)
(with-helm-buffer
(replace-match
(format "%s\\2\\3"
(propertize (replace-match "\\1" t nil (car i))
'face `(:foreground ,foreground)))
t nil (car i))))
;; org-startup-indented is nil, and org-hide-leading-stars is nil
;; Or: #+STARTUP: noindent showstars
(t
(with-helm-buffer
(replace-match "\\1\\2\\3" t nil (car i)))))))))
(cdr i)))))

(defun helm-org-get-candidates (filenames &optional parents)
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@thierryvolpiatto Spacemacs used this function syl20bnr/spacemacs#13123

Would you have a suggestion what function can be used instead? 🤔

"Get org headings for file FILENAMES.
Get PARENTS of heading when specified."
(apply #'append
(mapcar (lambda (filename)
(helm-org--get-candidates-in-file
filename
helm-org-headings-fontify
(or parents (null helm-org-show-filename))
parents))
filenames)))
(defvar helm-org--headers-cache nil)
(defvar helm-org--buffer-tick nil)

(defun helm-org-build-sources (filenames &optional parents)
(cl-loop for file in filenames
for name = (if (bufferp file)
(buffer-name file)
(helm-basename file))
collect
(helm-build-sync-source (format "Org headings (%s)" name)
:candidates (helm-dynamic-completion
(helm-org--get-candidates-in-file
file
helm-org-headings-fontify
(or parents (null helm-org-show-filename))
parents)
'stringp
nil '(metadata (display-sort-function
.
(lambda (candidates)
(sort candidates
#'helm-generic-sort-fn)))))
:match-dynamic t
:action 'helm-org-headings-actions
:keymap helm-org-headings-map
:group 'helm-org)))

(defun helm-org--get-candidates-in-file (filename &optional fontify nofname parents)
"Get candidates for org FILENAME.
Expand All @@ -300,60 +237,69 @@ Get PARENTS as well when specified."
(with-current-buffer (pcase filename
((pred bufferp) filename)
((pred stringp) (find-file-noselect filename t)))
(let ((match-fn (if fontify
#'match-string
#'match-string-no-properties))
(search-fn (lambda ()
(re-search-forward
org-complex-heading-regexp nil t)))
(file (unless (or (bufferp filename) nofname)
(concat (helm-basename filename) ":"))))
(when parents
(add-function :around (var search-fn)
(lambda (old-fn &rest args)
(when (org-up-heading-safe)
(apply old-fn args)))))
(save-excursion
(save-restriction
(unless (and (bufferp filename)
(buffer-base-buffer filename))
;; Only widen direct buffers, not indirect ones.
(widen))
(unless parents (goto-char (point-min)))
;; clear cache for new version of org-get-outline-path
(and (boundp 'org-outline-path-cache)
(setq org-outline-path-cache nil))
(cl-loop with width = (window-width (helm-window))
while (funcall search-fn)
for beg = (point-at-bol)
for end = (point-at-eol)
when (and fontify
(null (text-property-any
beg end 'fontified t)))
do (jit-lock-fontify-now beg end)
for level = (length (match-string-no-properties 1))
for heading = (funcall match-fn 4)
if (and (>= level helm-org-headings-min-depth)
(<= level helm-org-headings-max-depth))
collect `(,(propertize
(if helm-org-format-outline-path
(org-format-outline-path
;; org-get-outline-path changed in signature and behaviour since org's
;; commit 105a4466971. Let's fall-back to the new version in case
;; of wrong-number-of-arguments error.
(condition-case nil
(append (apply #'org-get-outline-path
(unless parents
(list t level heading)))
(list heading))
(wrong-number-of-arguments
(org-get-outline-path t t)))
width file)
(if file
(concat file (funcall match-fn 0))
(funcall match-fn 0)))
'helm-real-display heading)
. ,(point-marker))))))))
(let ((tick (buffer-chars-modified-tick)))
(if (and helm-org--buffer-tick
(= tick helm-org--buffer-tick))
helm-org--headers-cache
(message "Refreshing cache in `%s'..." (buffer-name))
(set (make-local-variable 'helm-org--buffer-tick) tick)
(prog1
(set (make-local-variable 'helm-org--headers-cache)
(let ((match-fn (if fontify
#'match-string
#'match-string-no-properties))
(search-fn (lambda ()
(re-search-forward
org-complex-heading-regexp nil t)))
(file (unless (or (bufferp filename) nofname)
(concat (helm-basename filename) ":"))))
(when parents
(add-function :around (var search-fn)
(lambda (old-fn &rest args)
(when (org-up-heading-safe)
(apply old-fn args)))))
(save-excursion
(save-restriction
(unless (and (bufferp filename)
(buffer-base-buffer filename))
;; Only widen direct buffers, not indirect ones.
(widen))
(unless parents (goto-char (point-min)))
;; clear cache for new version of org-get-outline-path
(and (boundp 'org-outline-path-cache)
(setq org-outline-path-cache nil))
(cl-loop with width = (window-width (helm-window))
while (funcall search-fn)
for beg = (point-at-bol)
for end = (point-at-eol)
when (and fontify
(null (text-property-any
beg end 'fontified t)))
do (jit-lock-fontify-now beg end)
for level = (length (match-string-no-properties 1))
for heading = (funcall match-fn 4)
if (and (>= level helm-org-headings-min-depth)
(<= level helm-org-headings-max-depth))
collect (propertize
(if helm-org-format-outline-path
(org-format-outline-path
;; org-get-outline-path changed in signature and behaviour since org's
;; commit 105a4466971. Let's fall-back to the new version in case
;; of wrong-number-of-arguments error.
(condition-case nil
(append (apply #'org-get-outline-path
(unless parents
(list t level heading)))
(list heading))
(wrong-number-of-arguments
(org-get-outline-path t t)))
width file)
(if file
(concat file (funcall match-fn 0))
(funcall match-fn 0)))
'helm-real-display heading
'helm-realvalue (point-marker)))))))
(message "Refreshing cache in `%s' done" (buffer-name)))))))

(defun helm-org-insert-link-to-heading-at-marker (marker)
"Insert link to heading at MARKER position."
Expand Down Expand Up @@ -418,24 +364,27 @@ will be refiled."
(expand-file-name
(concat "#" (helm-basename f) "#")
(helm-basedir f)))
collect (helm-basename f))))
collect (helm-basename f)))
(files (org-agenda-files))
org-hide-leading-stars
org-startup-indented)
(when (or (null autosaves)
helm-org-ignore-autosaves
(y-or-n-p (format "%s have auto save data, continue? "
(mapconcat #'identity autosaves ", "))))
(helm :sources (helm-source-org-headings-for-files (org-agenda-files))
:candidate-number-limit 99999
(helm :sources (helm-org-build-sources files)
:truncate-lines helm-org-truncate-lines
:buffer "*helm org headings*"))))

;;;###autoload
(defun helm-org-in-buffer-headings ()
"Preconfigured helm for org buffer headings."
(interactive)
(let (helm-org-show-filename)
(helm :sources (helm-source-org-headings-for-files
(list (current-buffer)))
:candidate-number-limit 99999
(let (helm-org-show-filename
(files (list (current-buffer)))
org-startup-indented
org-hide-leading-stars)
(helm :sources (helm-org-build-sources files)
:preselect (helm-org-in-buffer-preselect)
:truncate-lines helm-org-truncate-lines
:buffer "*helm org inbuffer*")))
Expand All @@ -446,10 +395,9 @@ will be refiled."
(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
(helm-org-headings-max-depth 50)
(files (list (current-buffer))))
(helm :sources (helm-org-build-sources files t)
:truncate-lines helm-org-truncate-lines
:buffer "*helm org parent headings*")))

Expand All @@ -458,7 +406,6 @@ will be refiled."
"Preconfigured helm for org templates."
(interactive)
(helm :sources (helm-source-org-capture-templates)
:candidate-number-limit 99999
:truncate-lines helm-org-truncate-lines
:buffer "*helm org capture templates*"))

Expand Down