From fd0732810fef13970ee432cca7fd948574fae89a Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Thu, 28 Nov 2019 15:11:15 +0100 Subject: [PATCH 1/8] Use dynamic completion helm-org-startup-visibility filter have been disabled for now as it is not working for some reasons (seems also it slowdown helm-org). --- helm-org.el | 112 ++++++++++++++-------------------------------------- 1 file changed, 29 insertions(+), 83 deletions(-) diff --git a/helm-org.el b/helm-org.el index ab8e220..662a400 100644 --- a/helm-org.el +++ b/helm-org.el @@ -202,88 +202,25 @@ 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))))) + (helm-build-sync-source "Org headings" + :candidates (helm-dynamic-completion + (helm-org-get-candidates + filenames parents) + 'stringp) + :match-dynamic t + :action 'helm-org-headings-actions + :keymap helm-org-headings-map + :group 'helm-org + :requires-pattern 2)) (defun helm-org-get-candidates (filenames &optional parents) "Get org headings for file FILENAMES. Get PARENTS of heading when specified." - (apply #'append + (apply #'append ; Flatten list. (mapcar (lambda (filename) (helm-org--get-candidates-in-file filename @@ -324,7 +261,11 @@ Get PARENTS as well when specified." (and (boundp 'org-outline-path-cache) (setq org-outline-path-cache nil)) (cl-loop with width = (window-width (helm-window)) - while (funcall search-fn) + while (and (funcall search-fn) + (string-match-p + helm-pattern + (buffer-substring-no-properties + (point-at-bol) (point-at-eol)))) for beg = (point-at-bol) for end = (point-at-eol) when (and fontify @@ -418,12 +359,15 @@ 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)) + (helm :sources (helm-source-org-headings-for-files files) :candidate-number-limit 99999 :truncate-lines helm-org-truncate-lines :buffer "*helm org headings*")))) @@ -432,9 +376,11 @@ will be refiled." (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))) + (let (helm-org-show-filename + (files (list (current-buffer))) + org-startup-indented + org-hide-leading-stars) + (helm :sources (helm-source-org-headings-for-files files) :candidate-number-limit 99999 :preselect (helm-org-in-buffer-preselect) :truncate-lines helm-org-truncate-lines @@ -446,9 +392,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) + (helm-org-headings-max-depth 50) + (files (list (current-buffer)))) + (helm :sources (helm-source-org-headings-for-files files t) :candidate-number-limit 99999 :truncate-lines helm-org-truncate-lines :buffer "*helm org parent headings*"))) From 9128377f19617228d66c110408abaf9fb07224b5 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Thu, 28 Nov 2019 21:38:51 +0100 Subject: [PATCH 2/8] No need to filter with helm-pattern * helm-org.el (helm-org--get-candidates-in-file): Do it. --- helm-org.el | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/helm-org.el b/helm-org.el index 662a400..9f9038b 100644 --- a/helm-org.el +++ b/helm-org.el @@ -261,11 +261,7 @@ Get PARENTS as well when specified." (and (boundp 'org-outline-path-cache) (setq org-outline-path-cache nil)) (cl-loop with width = (window-width (helm-window)) - while (and (funcall search-fn) - (string-match-p - helm-pattern - (buffer-substring-no-properties - (point-at-bol) (point-at-eol)))) + while (funcall search-fn) for beg = (point-at-bol) for end = (point-at-eol) when (and fontify From e3f1dd212188aff66b8df89e42c69ade89fe064d Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Thu, 28 Nov 2019 21:59:07 +0100 Subject: [PATCH 3/8] Sort candidates * helm-org.el (helm-source-org-headings-for-files): Do it. --- helm-org.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/helm-org.el b/helm-org.el index 9f9038b..e9af429 100644 --- a/helm-org.el +++ b/helm-org.el @@ -210,7 +210,12 @@ current heading." :candidates (helm-dynamic-completion (helm-org-get-candidates filenames parents) - 'stringp) + '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 From 14d8188ede33f30ef3a29508a579054d788931f6 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Fri, 29 Nov 2019 16:24:10 +0100 Subject: [PATCH 4/8] Fix helm-realvalue * helm-org.el (helm-org--get-candidates-in-file): Don't use a cons cell but bind helm-realvalue prop. --- helm-org.el | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/helm-org.el b/helm-org.el index e9af429..62b5682 100644 --- a/helm-org.el +++ b/helm-org.el @@ -277,25 +277,25 @@ Get PARENTS as well when specified." 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)))))))) + 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)))))))) (defun helm-org-insert-link-to-heading-at-marker (marker) "Insert link to heading at MARKER position." From 71833a82d9954b41c313180bd1dbc771b8ed50d0 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Fri, 29 Nov 2019 17:01:43 +0100 Subject: [PATCH 5/8] Don't bind candidate-number-limit to hight value it is not needed with the dynamic function that ensure all candidates are computed and sorted. --- helm-org.el | 4 ---- 1 file changed, 4 deletions(-) diff --git a/helm-org.el b/helm-org.el index 62b5682..b9c2924 100644 --- a/helm-org.el +++ b/helm-org.el @@ -369,7 +369,6 @@ will be refiled." (y-or-n-p (format "%s have auto save data, continue? " (mapconcat #'identity autosaves ", ")))) (helm :sources (helm-source-org-headings-for-files files) - :candidate-number-limit 99999 :truncate-lines helm-org-truncate-lines :buffer "*helm org headings*")))) @@ -382,7 +381,6 @@ will be refiled." org-startup-indented org-hide-leading-stars) (helm :sources (helm-source-org-headings-for-files files) - :candidate-number-limit 99999 :preselect (helm-org-in-buffer-preselect) :truncate-lines helm-org-truncate-lines :buffer "*helm org inbuffer*"))) @@ -396,7 +394,6 @@ will be refiled." (helm-org-headings-max-depth 50) (files (list (current-buffer)))) (helm :sources (helm-source-org-headings-for-files files t) - :candidate-number-limit 99999 :truncate-lines helm-org-truncate-lines :buffer "*helm org parent headings*"))) @@ -405,7 +402,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*")) From a4d82784e2c4c677a0a92abf7e952ea7e8c04341 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Fri, 29 Nov 2019 17:07:32 +0100 Subject: [PATCH 6/8] Remove requires-pattern --- helm-org.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/helm-org.el b/helm-org.el index b9c2924..59bb33f 100644 --- a/helm-org.el +++ b/helm-org.el @@ -219,8 +219,7 @@ current heading." :match-dynamic t :action 'helm-org-headings-actions :keymap helm-org-headings-map - :group 'helm-org - :requires-pattern 2)) + :group 'helm-org)) (defun helm-org-get-candidates (filenames &optional parents) "Get org headings for file FILENAMES. From 8e875b048a0ac47d0b57951aecb6715220a38e6b Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Fri, 29 Nov 2019 19:37:16 +0100 Subject: [PATCH 7/8] Use a cache as local variable for each buffer like in helm-imenu. * helm-org.el (helm-org--headers-cache): New internals. (helm-org--buffer-tick): New internals. (helm-org-build-sources): New. (helm-org--get-candidates-in-file): Set cache in each buffer. (helm-org-agenda-files-headings): Use separate sources. (helm-org-in-buffer-headings): Use new fn helm-org-build-sources. (helm-org-parent-headings): Same. --- helm-org.el | 179 +++++++++++++++++++++++++++------------------------- 1 file changed, 92 insertions(+), 87 deletions(-) diff --git a/helm-org.el b/helm-org.el index 59bb33f..b8b2e7b 100644 --- a/helm-org.el +++ b/helm-org.el @@ -202,36 +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'.") -(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-build-sync-source "Org headings" - :candidates (helm-dynamic-completion - (helm-org-get-candidates - filenames 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 (filenames &optional parents) - "Get org headings for file FILENAMES. -Get PARENTS of heading when specified." - (apply #'append ; 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))) +(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. @@ -241,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 - 'helm-realvalue (point-marker)))))))) + (let ((tick (buffer-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." @@ -367,7 +372,7 @@ will be refiled." 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 files) + (helm :sources (helm-org-build-sources files) :truncate-lines helm-org-truncate-lines :buffer "*helm org headings*")))) @@ -379,7 +384,7 @@ will be refiled." (files (list (current-buffer))) org-startup-indented org-hide-leading-stars) - (helm :sources (helm-source-org-headings-for-files files) + (helm :sources (helm-org-build-sources files) :preselect (helm-org-in-buffer-preselect) :truncate-lines helm-org-truncate-lines :buffer "*helm org inbuffer*"))) @@ -392,7 +397,7 @@ will be refiled." (let ((helm-org-headings-min-depth 1) (helm-org-headings-max-depth 50) (files (list (current-buffer)))) - (helm :sources (helm-source-org-headings-for-files files t) + (helm :sources (helm-org-build-sources files t) :truncate-lines helm-org-truncate-lines :buffer "*helm org parent headings*"))) From 5311845706594646932e3456d92b4a0f1f7764a9 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Fri, 29 Nov 2019 19:51:26 +0100 Subject: [PATCH 8/8] Use buffer-chars-modified-tick to not update when only visiting. --- helm-org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/helm-org.el b/helm-org.el index b8b2e7b..6ee20c4 100644 --- a/helm-org.el +++ b/helm-org.el @@ -237,7 +237,7 @@ Get PARENTS as well when specified." (with-current-buffer (pcase filename ((pred bufferp) filename) ((pred stringp) (find-file-noselect filename t))) - (let ((tick (buffer-modified-tick))) + (let ((tick (buffer-chars-modified-tick))) (if (and helm-org--buffer-tick (= tick helm-org--buffer-tick)) helm-org--headers-cache