From 27a03dd97fc7e904058dfdbf4bcdf386b3479c9f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 10 Sep 2017 14:08:16 +0200 Subject: [PATCH 1/2] org-agenda: Fix `org-agenda-skip-if' * lisp/org-agenda.el (org-agenda-skip-if): Prevent some checks from moving point, since this stops following checks from running properly. Reported-by: "cro cefisso" --- lisp/org-agenda.el | 66 ++++++++++++++++++++++++---------------------- 1 file changed, 34 insertions(+), 32 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 180bb7417..96ff7c69d 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -4878,39 +4878,41 @@ keywords. Possible classes are: `todo', `done', `any'. If any of these conditions is met, this function returns the end point of the entity, causing the search to continue from there. This is a function that can be put into `org-agenda-skip-function' for the duration of a command." - (let (beg end m) - (org-back-to-heading t) - (setq beg (point) - end (if subtree - (progn (org-end-of-subtree t) (point)) - (progn (outline-next-heading) (1- (point))))) - (goto-char beg) + (org-back-to-heading t) + (let* ((beg (point)) + (end (if subtree (save-excursion (org-end-of-subtree t) (point)) + (org-entry-end-position))) + (planning-end (if subtree end (line-end-position 2))) + m) (and - (or - (and (memq 'scheduled conditions) - (re-search-forward org-scheduled-time-regexp end t)) - (and (memq 'notscheduled conditions) - (not (re-search-forward org-scheduled-time-regexp end t))) - (and (memq 'deadline conditions) - (re-search-forward org-deadline-time-regexp end t)) - (and (memq 'notdeadline conditions) - (not (re-search-forward org-deadline-time-regexp end t))) - (and (memq 'timestamp conditions) - (re-search-forward org-ts-regexp end t)) - (and (memq 'nottimestamp conditions) - (not (re-search-forward org-ts-regexp end t))) - (and (setq m (memq 'regexp conditions)) - (stringp (nth 1 m)) - (re-search-forward (nth 1 m) end t)) - (and (setq m (memq 'notregexp conditions)) - (stringp (nth 1 m)) - (not (re-search-forward (nth 1 m) end t))) - (and (or - (setq m (memq 'nottodo conditions)) - (setq m (memq 'todo-unblocked conditions)) - (setq m (memq 'nottodo-unblocked conditions)) - (setq m (memq 'todo conditions))) - (org-agenda-skip-if-todo m end))) + (or (and (memq 'scheduled conditions) + (re-search-forward org-scheduled-time-regexp planning-end t)) + (and (memq 'notscheduled conditions) + (not + (save-excursion + (re-search-forward org-scheduled-time-regexp planning-end t)))) + (and (memq 'deadline conditions) + (re-search-forward org-deadline-time-regexp planning-end t)) + (and (memq 'notdeadline conditions) + (not + (save-excursion + (re-search-forward org-deadline-time-regexp planning-end t)))) + (and (memq 'timestamp conditions) + (re-search-forward org-ts-regexp end t)) + (and (memq 'nottimestamp conditions) + (not (save-excursion (re-search-forward org-ts-regexp end t)))) + (and (setq m (memq 'regexp conditions)) + (stringp (nth 1 m)) + (re-search-forward (nth 1 m) end t)) + (and (setq m (memq 'notregexp conditions)) + (stringp (nth 1 m)) + (not (save-excursion (re-search-forward (nth 1 m) end t)))) + (and (or + (setq m (memq 'nottodo conditions)) + (setq m (memq 'todo-unblocked conditions)) + (setq m (memq 'nottodo-unblocked conditions)) + (setq m (memq 'todo conditions))) + (org-agenda-skip-if-todo m end))) end))) (defun org-agenda-skip-if-todo (args end) From 1168d085d2182fed6019848d676a89a2f54fa64b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 10 Sep 2017 14:10:49 +0200 Subject: [PATCH 2/2] org-agenda: Fix `org-agenda-skip-if-todo' * lisp/org-agenda.el (org-agenda-skip-if-todo): Make sure TODO search is case sensitive. Refactor function. --- lisp/org-agenda.el | 67 +++++++++++++++++++++------------------------- 1 file changed, 30 insertions(+), 37 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 96ff7c69d..03d4e37cf 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -4921,43 +4921,36 @@ ARGS is a list with first element either `todo', `nottodo', `todo-unblocked' or `nottodo-unblocked'. The remainder is either a list of TODO keywords, or a state symbol `todo' or `done' or `any'." - (let ((kw (car args)) - (arg (cadr args)) - todo-wds todo-re) - (setq todo-wds - (org-uniquify - (cond - ((listp arg) ;; list of keywords - (if (member "*" arg) - (mapcar 'substring-no-properties org-todo-keywords-1) - arg)) - ((symbolp arg) ;; keyword class name - (cond - ((eq arg 'todo) - (org-delete-all org-done-keywords - (mapcar 'substring-no-properties - org-todo-keywords-1))) - ((eq arg 'done) org-done-keywords) - ((eq arg 'any) - (mapcar 'substring-no-properties org-todo-keywords-1))))))) - (setq todo-re - (concat "^\\*+[ \t]+\\<\\(" - (mapconcat 'identity todo-wds "\\|") - "\\)\\>")) - (cond - ((eq kw 'todo) (re-search-forward todo-re end t)) - ((eq kw 'nottodo) (not (re-search-forward todo-re end t))) - ((eq kw 'todo-unblocked) - (catch 'unblocked - (while (re-search-forward todo-re end t) - (or (org-entry-blocked-p) (throw 'unblocked t))) - nil)) - ((eq kw 'nottodo-unblocked) - (catch 'unblocked - (while (re-search-forward todo-re end t) - (or (org-entry-blocked-p) (throw 'unblocked nil))) - t)) - ))) + (let ((todo-re + (concat "^\\*+[ \t]+" + (regexp-opt + (pcase args + (`(,_ todo) + (org-delete-all org-done-keywords + (copy-sequence org-todo-keywords-1))) + (`(,_ done) org-done-keywords) + (`(,_ any) org-todo-keywords-1) + (`(,_ ,(pred atom)) + (error "Invalid TODO class or type: %S" args)) + (`(,_ ,(pred (member "*"))) org-todo-keywords-1) + (`(,_ ,todo-list) todo-list)) + 'words)))) + (pcase args + (`(todo . ,_) + (let (case-fold-search) (re-search-forward todo-re end t))) + (`(nottodo . ,_) + (not (let (case-fold-search) (re-search-forward todo-re end t)))) + (`(todo-unblocked . ,_) + (catch :unblocked + (while (let (case-fold-search) (re-search-forward todo-re end t)) + (when (org-entry-blocked-p) (throw :unblocked t))) + nil)) + (`(nottodo-unblocked . ,_) + (catch :unblocked + (while (let (case-fold-search) (re-search-forward todo-re end t)) + (when (org-entry-blocked-p) (throw :unblocked nil))) + t)) + (`(,type . ,_) (error "Unknown TODO skip type: %S" type))))) ;;;###autoload (defun org-agenda-list-stuck-projects (&rest ignore)