emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Jean Louis <bugs@gnu.support>
To: Nathan Neff <nathan.neff@gmail.com>
Cc: emacs-orgmode <emacs-orgmode@gnu.org>
Subject: Re: Configure Helm Source from org-tags-view
Date: Thu, 8 Aug 2019 22:29:01 +0200	[thread overview]
Message-ID: <20190808202901.GO23122@protected.rcdrun.com> (raw)
In-Reply-To: <CAC=HedDxnvipwOmYg23Mi+gz=es3Eq5QXN+MOgBM_0qaAw-mnA@mail.gmail.com>

* 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)))

  parent reply	other threads:[~2019-08-08 20:29 UTC|newest]

Thread overview: 13+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2019-08-08 16:49 Configure Helm Source from org-tags-view Nathan Neff
2019-08-08 19:00 ` Jean Louis
2019-08-08 19:13 ` Jean Louis
2019-08-08 20:03   ` Nathan Neff
2019-08-08 20:23     ` Nathan Neff
2019-08-08 20:30       ` Jean Louis
2019-08-08 20:46         ` Nathan Neff
2019-08-08 21:20           ` Jean Louis
2019-08-08 20:29     ` Jean Louis [this message]
2019-08-09 11:07 ` Adam Porter
2019-08-09 17:57   ` Nathan Neff
2019-08-09 19:13     ` Adam Porter
2019-08-09 21:20       ` Nathan Neff

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20190808202901.GO23122@protected.rcdrun.com \
    --to=bugs@gnu.support \
    --cc=emacs-orgmode@gnu.org \
    --cc=nathan.neff@gmail.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).