Re: Configure Helm Source from org-tags-view

[Jean Louis <bugs@gnu.support>]

* Nathan Neff <nathan.neff@gmail.com> [2019-08-08 22:04]:
> Hi Jean,
> 
> Thank you - however, I can't get this function to return anything.
> 
> org-scan-tags accepts an action, a matcher and a todo-only.
> 
> Code:
> 
> (org-scan-tags 'agenda ;; Action
>                       '(staff lambda (todo tags-list level)  ;; Matcher
>                                (progn
>                                     (setq org-cached-props nil)
>                                     (or (and (member staff tags-list)))))
> ;; End Matcher
>                        org--matcher-tags-todo-only) ;; Todo-only
> 
> * To my knowledge, the 'agenda is the action, and the list starting with
> `(staff <snip>) is the matcher.

If you do not have tag "staff" you cannot find anything. So change it
to your own tag. But now after reading I see you have it actually

And function is not going to work outside Org buffer. So I have
evaluated it with M-:

In fact I did following:

(setq a (org-scan-tags 'agenda '(staff lambda (todo tags-list level) (progn (setq org-cached-props nil) (or (and (member staff tags-list)))))  org--matcher-tags-todo-only))

Then I have inspected 'a' in scratch buffer.

I see that it has various properties for faces, so is not quite the
best output.

> * Why does the tag I'm searching for (staff) appear as the first
> atom in the matcher parameter?  Why isn't it just a lambda?

Me not developer.

> * I don't quite understand what the or and and are doing.  It seems
> like I don't need either of them.

I just tried giving some pointers, so in org-scan-tags is probably the
solution.

When I looked at that function I got fascinated with the type of
programming that I don't like, maybe it is common in Emacs Lisp, but
not what I used to learn from Common Lisp. And I program in Emacs Lisp
in such way that one function evaluates and gives out some results. I
do not work with global variables from within functions.

I was programming in Perl and I stopped the nonsense, but not quite
"just in time". When looking at that function org-scan-tags it looks
to me as Perl. It is LISP without its beauty. I keep functions small
and simple.

My knowledge about "right way" is tiny. All I know is that it looks
ugly as Perl.

I would never do it this way. Not my style.

I would make a function that scans tags and gives out Emacs Lisp
structure, whatever it is.

Then anybody can do with the results whatever they want. We can then
make tags into helm or any other feature.

> My org-agenda-files contains files and I have a headline with the
> tag staff - no quotes, and the function's not returning anything.

Oh, you do have it?

-------------- don't abuse yourself by looking below

(defvar org--matcher-tags-todo-only nil)

(defun org-scan-tags (action matcher todo-only &optional start-level)
  "Scan headline tags with inheritance and produce output ACTION.

ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
or `agenda' to produce an entry list for an agenda view.  It can also be
a Lisp form or a function that should be called at each matched headline, in
this case the return value is a list of all return values from these calls.

MATCHER is a function accepting three arguments, returning
a non-nil value whenever a given set of tags qualifies a headline
for inclusion.  See `org-make-tags-matcher' for more information.
As a special case, it can also be set to t (respectively nil) in
order to match all (respectively none) headline.

When TODO-ONLY is non-nil, only lines with a TODO keyword are
included in the output.

START-LEVEL can be a string with asterisks, reducing the scope to
headlines matching this string."
  (require 'org-agenda)
  (let* ((re (concat "^"
		     (if start-level
			 ;; Get the correct level to match
			 (concat "\\*\\{" (number-to-string start-level) "\\} ")
		       org-outline-regexp)
		     " *\\(" (regexp-opt org-todo-keywords-1 'words) "\\)?"
		     " *\\(.*?\\)\\([ \t]:\\(?:" org-tag-re ":\\)+\\)?[ \t]*$"))
	 (props (list 'face 'default
		      'done-face 'org-agenda-done
		      'undone-face 'default
		      'mouse-face 'highlight
		      'org-not-done-regexp org-not-done-regexp
		      'org-todo-regexp org-todo-regexp
		      'org-complex-heading-regexp org-complex-heading-regexp
		      'help-echo
		      (format "mouse-2 or RET jump to Org file %S"
			      (abbreviate-file-name
			       (or (buffer-file-name (buffer-base-buffer))
				   (buffer-name (buffer-base-buffer)))))))
	 (org-map-continue-from nil)
         lspos tags tags-list
	 (tags-alist (list (cons 0 org-file-tags)))
	 (llast 0) rtn rtn1 level category i txt
	 todo marker entry priority
	 ts-date ts-date-type ts-date-pair)
    (unless (or (member action '(agenda sparse-tree)) (functionp action))
      (setq action (list 'lambda nil action)))
    (save-excursion
      (goto-char (point-min))
      (when (eq action 'sparse-tree)
	(org-overview)
	(org-remove-occur-highlights))
      (while (let (case-fold-search)
	       (re-search-forward re nil t))
	(setq org-map-continue-from nil)
	(catch :skip
	  ;; Ignore closing parts of inline tasks.
	  (when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p))
	    (throw :skip t))
	  (setq todo (and (match-end 1) (match-string-no-properties 1)))
	  (setq tags (and (match-end 4) (org-trim (match-string-no-properties 4))))
	  (goto-char (setq lspos (match-beginning 0)))
	  (setq level (org-reduced-level (org-outline-level))
		category (org-get-category))
          (when (eq action 'agenda)
            (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
		  ts-date (car ts-date-pair)
		  ts-date-type (cdr ts-date-pair)))
	  (setq i llast llast level)
	  ;; remove tag lists from same and sublevels
	  (while (>= i level)
	    (when (setq entry (assoc i tags-alist))
	      (setq tags-alist (delete entry tags-alist)))
	    (setq i (1- i)))
	  ;; add the next tags
	  (when tags
	    (setq tags (org-split-string tags ":")
		  tags-alist
		  (cons (cons level tags) tags-alist)))
	  ;; compile tags for current headline
	  (setq tags-list
		(if org-use-tag-inheritance
		    (apply 'append (mapcar 'cdr (reverse tags-alist)))
		  tags)
		org-scanner-tags tags-list)
	  (when org-use-tag-inheritance
	    (setcdr (car tags-alist)
		    (mapcar (lambda (x)
			      (setq x (copy-sequence x))
			      (org-add-prop-inherited x))
			    (cdar tags-alist))))
	  (when (and tags org-use-tag-inheritance
		     (or (not (eq t org-use-tag-inheritance))
			 org-tags-exclude-from-inheritance))
	    ;; Selective inheritance, remove uninherited ones.
	    (setcdr (car tags-alist)
		    (org-remove-uninherited-tags (cdar tags-alist))))
	  (when (and

		 ;; eval matcher only when the todo condition is OK
		 (and (or (not todo-only) (member todo org-todo-keywords-1))
		      (if (functionp matcher)
			  (let ((case-fold-search t) (org-trust-scanner-tags t))
			    (funcall matcher todo tags-list level))
			matcher))

		 ;; Call the skipper, but return t if it does not
		 ;; skip, so that the `and' form continues evaluating.
		 (progn
		   (unless (eq action 'sparse-tree) (org-agenda-skip))
		   t)

		 ;; Check if timestamps are deselecting this entry
		 (or (not todo-only)
		     (and (member todo org-todo-keywords-1)
			  (or (not org-agenda-tags-todo-honor-ignore-options)
			      (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))

	    ;; select this headline
	    (cond
	     ((eq action 'sparse-tree)
	      (and org-highlight-sparse-tree-matches
		   (org-get-heading) (match-end 0)
		   (org-highlight-new-match
		    (match-beginning 1) (match-end 1)))
	      (org-show-context 'tags-tree))
	     ((eq action 'agenda)
	      (setq txt (org-agenda-format-item
			 ""
			 (concat
			  (if (eq org-tags-match-list-sublevels 'indented)
			      (make-string (1- level) ?.) "")
			  (org-get-heading))
			 (make-string level ?\s)
			 category
			 tags-list)
		    priority (org-get-priority txt))
	      (goto-char lspos)
	      (setq marker (org-agenda-new-marker))
	      (org-add-props txt props
		'org-marker marker 'org-hd-marker marker 'org-category category
		'todo-state todo
                'ts-date ts-date
		'priority priority
                'type (concat "tagsmatch" ts-date-type))
	      (push txt rtn))
	     ((functionp action)
	      (setq org-map-continue-from nil)
	      (save-excursion
		(setq rtn1 (funcall action))
		(push rtn1 rtn)))
	     (t (user-error "Invalid action")))

	    ;; if we are to skip sublevels, jump to end of subtree
	    (unless org-tags-match-list-sublevels
	      (org-end-of-subtree t)
	      (backward-char 1))))
	;; Get the correct position from where to continue
	(if org-map-continue-from
	    (goto-char org-map-continue-from)
	  (and (= (point) lspos) (end-of-line 1)))))
    (when (and (eq action 'sparse-tree)
	       (not org-sparse-tree-open-archived-trees))
      (org-hide-archived-subtrees (point-min) (point-max)))
    (nreverse rtn)))