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

Make :date behave as :deadline and :scheduled #96

Open
wants to merge 12 commits into
base: master
Choose a base branch
from
Open

Make :date behave as :deadline and :scheduled #96

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
12 commits
Select commit Hold shift + click to select a range
ec83138
Use SCHEDULED/DEADLINE template for timestamps
zaeph Jul 15, 2019
f566e3d
Reorganise defgroups based on time info
zaeph Jul 15, 2019
f8ceae5
Implement date-matcher macro
zaeph Jul 15, 2019
213a850
Make doc-string the 2nd argument of the defgroup macros
zaeph Jul 15, 2019
5580786
Replace defgroups for time with defgroup-with-time-tests
zaeph Jul 15, 2019
cc59437
Deprecate/alias :date in favour of :timestamp
zaeph Jul 15, 2019
ffba1d6
Update README.org
zaeph Jul 15, 2019
4fe8ef5
Update README.info
zaeph Jul 15, 2019
a7c5176
Update README.info to makeinfo 6.6
zaeph Jul 15, 2019
da49946
README: Place ‘timestamp’ in alphabetical order
zaeph Jul 15, 2019
4a00534
Fix mishandled deprecation
zaeph Jul 15, 2019
d4f8a51
Revert "Deprecate/alias :date in favour of :timestamp"
zaeph Jul 15, 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
6 changes: 3 additions & 3 deletions README.org
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -186,8 +186,7 @@ These selectors take one argument alone, or multiple arguments in a list.

+ =:category= :: Group items that match any of the given categories. Argument may be a string or list of strings.
+ =:children= :: Select any item that has child entries. Argument may be ~t~ to match if it has any children, ~nil~ to match if it has no children, ~todo~ to match if it has children with any to-do keywords, or a string to match if it has children with certain to-do keywords. You might use this to select items that are project top-level headings. Be aware that this may be very slow in non-daily/weekly agenda views because of its recursive nature.
+ =:date= :: Group items that have a date associated. Argument can be =t= to match items with any date, =nil= to match items without a date, or =today= to match items with today’s date. The =ts-date= text-property is matched against.
+ =:deadline= :: Group items that have a deadline. Argument can be ~t~ (to match items with any deadline), ~nil~ (to match items that have no deadline), ~past~ (to match items with a deadline in the past), ~today~ (to match items whose deadline is today), or ~future~ (to match items with a deadline in the future). Argument may also be given like ~before DATE~ or ~after DATE~ where DATE is a date string that ~org-time-string-to-absolute~ can process.
+ =:deadline= :: Group items that have a deadline. Argument can be ~t~ (to match items with any deadline), ~nil~ (to match items that have no deadline), ~past~ (to match items with a deadline in the past), ~today~ (to match items whose deadline is today), or ~future~ (to match items with a deadline in the future). Argument may also be given like ~before DATE~ or ~after DATE~ where ~DATE~ is a date string that ~org-time-string-to-absolute~ can process.
+ =:effort<= :: Group items that are less than (or equal to) the given effort. Argument is a time-duration string, like ~5~ or ~0:05~ for 5 minutes.
+ =:effort>= :: Group items that are higher than (or equal to) the given effort. Argument is a time-duration string, like ~5~ or ~0:05~ for 5 minutes.
+ ~:file-path~ :: Group items whose buffers' filename paths match any of the given regular expressions.
Expand All @@ -201,9 +200,10 @@ These selectors take one argument alone, or multiple arguments in a list.
+ =:priority<= :: Group items that are lower than the given priority, e.g. ~A~.
+ =:priority<== :: Group items that are lower than or equal to the given priority, e.g. ~B~.
+ =:regexp= :: Group items that match any of the given regular expressions.
+ =:scheduled= :: Group items that are scheduled. Argument can be ~t~ (to match items scheduled for any date), ~nil~ (to match items that are not schedule), ~past~ (to match items scheduled for the past), ~today~ (to match items scheduled for today), or ~future~ (to match items scheduled for the future). Argument may also be given like ~before DATE~ or ~after DATE~ where DATE is a date string that ~org-time-string-to-absolute~ can process.
+ =:scheduled= :: Group items that are scheduled. Argument can be ~t~ (to match items scheduled for any date), ~nil~ (to match items that are not schedule), ~past~ (to match items scheduled for the past), ~today~ (to match items scheduled for today), or ~future~ (to match items scheduled for the future). Argument may also be given like ~before DATE~ or ~after DATE~ where ~DATE~ is a date string that ~org-time-string-to-absolute~ can process.
+ =:tag= :: Group items that match any of the given tags. Argument may be a string or list of strings.
+ =:time-grid= :: Group items that appear on the time grid.
+ =:timestamp= :: Group items that have a timestamp. Argument can be ~t~ (to match items with any timestamp), ~nil~ (to match items that have no timestamp), ~past~ (to match items with a timestamp in the past), ~today~ (to match items whose timestamp is today), or ~future~ (to match items with a timestamp in the future). Argument may also be given like ~before DATE~ or ~after DATE~ where ~DATE~ is a date string that ~org-time-string-to-absolute~ can process.
+ =:todo= :: Group items that match any of the given TODO keywords. Argument may be a string or list of strings, or ~t~ to match any keyword, or ~nil~ to match only non-todo items.

** Tips
Expand Down
151 changes: 82 additions & 69 deletions org-super-agenda.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -335,6 +335,7 @@ returned by :SECTION-NAME as the first item, a list of items not
matching the :TEST as the second, and a list of items matching as
the third."
(declare (indent defun)
(doc-string 2)
(debug (&define symbolp stringp
&rest [&or [":section-name" [&or stringp def-form]]
[":test" def-form]
Expand All @@ -358,26 +359,39 @@ the third."

;;;;; Date/time-related

;; TODO: I guess these should be in a date-matcher macro
(cl-defmacro org-super-agenda--defgroup-with-time-tests (name docstring &key section-name test-property let*)
"Define an agenda-item group function based on time info.

(org-super-agenda--defgroup date
"Group items that have a date associated.
Argument can be `t' to match items with any date, `nil' to match
items without a date, or `today' to match items with today's
date. The `ts-date' text-property is matched against. "
:section-name "Dated items" ; Note: this does not mean the item has a "SCHEDULED:" line
:let* ((today (org-today)))
:test (pcase (car args)
('t ;; Test for any date
(org-find-text-property-in-string 'ts-date item))
('nil ;; Test for not having a date
(not (org-find-text-property-in-string 'ts-date item)))
('today ;; Items that have a time sometime today
;; TODO: Maybe I can use the ts-date property in some other places, might be faster
(when-let ((day (org-find-text-property-in-string 'ts-date item)))
(= day today)))
(_ ;; Oops
(user-error "Argument to `:date' must be `t', `nil', or `today'"))))
:TEST-PROPERTY is the property string on which to run the tests.
It can be one of the special properties like `TIMESTAMP',
`SCHEDULED' or `DEADLINE', but it can also be a user-defined
property like `CREATED'.

For more information on the other parameters, see
`org-super-agenda--defgroup'."
(declare (indent defun)
(doc-string 2))
`(org-super-agenda--defgroup ,name
,docstring
:section-name ,section-name
:let* ((today (pcase (car args) ; Perhaps premature optimization
((or 'past 'today 'future 'before 'on 'after)
(org-today))))
(target-date (pcase (car args)
((or 'before 'on 'after)
(org-time-string-to-absolute (second args))))))
:test (org-super-agenda--when-with-marker-buffer (org-super-agenda--get-marker item)
(let ((entry-time (org-entry-get (point) ,test-property)))
(pcase (car args)
('t entry-time) ; Has any timestamp
('nil (not entry-time)) ; Has no timestamp
(comparison
(when entry-time
(let ((entry-time (org-time-string-to-absolute entry-time))
(compare-date (pcase comparison
((or 'past 'today 'future) today)
((or 'before 'on 'after) target-date))))
(org-super-agenda--compare-dates comparison entry-time compare-date)))))))))

(org-super-agenda--defgroup time-grid
"Group items that appear on a time grid.
Expand All @@ -397,8 +411,28 @@ agenda time-grid. "
;; the time-grid. Yes, this is confusing. :)
(not (eql it 'time)))))

(org-super-agenda--defgroup deadline
"Group items that have a deadline.
(org-super-agenda--defgroup-with-time-tests timestamp
"Group items that have a timestamp.
Argument can be `t' (to match items with any timestamp),
`nil' (to match items that have no timestamp), `past' (to match
items with a timestamp in the past), `today' (to match items
whose timestamp for today), or `future' (to match items with
a timestamp in the future). Argument may also be given like
`before DATE' or `after DATE', where DATE is a date string that
`org-time-string-to-absolute' can process."
:section-name (pcase (car args)
('t "Timestamp items")
('nil "Items without timestamps")
('past "Timestamps in the past")
('today "Timestamps for today")
('future "Timestamps in the future")
('before (concat "Timestamps before " (second args)))
('on (concat "Timestamps on " (second args)))
('after (concat "Timestamps after " (second args))))
:test-property "TIMESTAMP")

(org-super-agenda--defgroup-with-time-tests deadline
"Group items that have a deadline.
Argument can be `t' (to match items with any deadline), `nil' (to
match items that have no deadline), `past` (to match items with a
deadline in the past), `today' (to match items whose deadline is
Expand All @@ -415,26 +449,9 @@ DATE', where DATE is a date string that
('before (concat "Due before " (second args)))
('on (concat "Due on " (second args)))
('after (concat "Due after " (second args))))
:let* ((today (pcase (car args) ; Perhaps premature optimization
((or 'past 'today 'future 'before 'on 'after)
(org-today))))
(target-date (pcase (car args)
((or 'before 'on 'after)
(org-time-string-to-absolute (second args))))))
:test (org-super-agenda--when-with-marker-buffer (org-super-agenda--get-marker item)
(let ((entry-time (org-entry-get (point) "DEADLINE")))
(pcase (car args)
('t entry-time) ; Has any deadline info
('nil (not entry-time)) ; Has no deadline info
(comparison
(when entry-time
(let ((entry-time (org-time-string-to-absolute entry-time))
(compare-date (pcase comparison
((or 'past 'today 'future) today)
((or 'before 'on 'after) target-date))))
(org-super-agenda--compare-dates comparison entry-time compare-date))))))))

(org-super-agenda--defgroup scheduled
:test-property "DEADLINE")

(org-super-agenda--defgroup-with-time-tests scheduled
"Group items that are scheduled.
Argument can be `t' (to match items scheduled for any date),
`nil' (to match items that are not schedule), `past` (to match
Expand All @@ -452,24 +469,7 @@ DATE', where DATE is a date string that
('before (concat "Scheduled before " (second args)))
('on (concat "Scheduled on " (second args)))
('after (concat "Scheduled after " (second args))))
:let* ((today (pcase (car args) ; Perhaps premature optimization
((or 'past 'today 'future 'before 'on 'after)
(org-today))))
(target-date (pcase (car args)
((or 'before 'on 'after)
(org-time-string-to-absolute (second args))))))
:test (org-super-agenda--when-with-marker-buffer (org-super-agenda--get-marker item)
(let ((entry-time (org-entry-get (point) "SCHEDULED")))
(pcase (car args)
('t entry-time) ; Has any scheduled info
('nil (not entry-time)) ; Has no scheduled info
(comparison
(when entry-time
(let ((entry-time (org-time-string-to-absolute entry-time))
(compare-date (pcase comparison
((or 'past 'today 'future) today)
((or 'before 'on 'after) target-date))))
(org-super-agenda--compare-dates comparison entry-time compare-date))))))))
:test-property "SCHEDULED")

(defun org-super-agenda--compare-dates (comparison date-a date-b)
"Compare DATE-A and DATE-B according to COMPARISON.
Expand Down Expand Up @@ -940,16 +940,29 @@ of the arguments to the function."
"Return function for SELECTOR, or nil if special selector.
Raise error if invalid selector."
(cond
((cl-member selector org-super-agenda-special-selectors)
;; Special selector, so no associated function; return nil
nil)
;; Valid selector: return function
((plist-get org-super-agenda-group-types selector))
((eq selector :habit)
;; :habit selector used but `org-habit' not loaded
(user-error "Please `require' the `org-habit' library to use the :habit selector"))
;; Invalid selector: raise error
((user-error "Invalid org-super-agenda-groups selector: %s" selector))))
((cl-member selector org-super-agenda-special-selectors)
;; Special selector, so no associated function; return nil
nil)
;; Valid selector: return function
((plist-get org-super-agenda-group-types selector))
((eq selector :habit)
;; :habit selector used but `org-habit' not loaded
(user-error "Please `require' the `org-habit' library to use the :habit selector"))
;; Deprecated selector: raise warning
((when-let ((new-selector (alist-get selector
Copy link
Author

Choose a reason for hiding this comment

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

I’m using alist-get, but I think this is a recent addition to Emacs. We can use (cdr (assoc …)) instead.

Copy link
Owner

Choose a reason for hiding this comment

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

alist-get is fine, and I much prefer it over (cdr (assoc. :)

Copy link
Author

Choose a reason for hiding this comment

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

Perfect! I was in the process of rebasing the commits on top of master. Would you like me to still do it?

Copy link
Author

Choose a reason for hiding this comment

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

I ended up merging master.

Copy link
Owner

@alphapapa alphapapa Jul 24, 2019 •
edited
Loading

Choose a reason for hiding this comment

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

Please rebase it. PRs should generally, if not always, be rebased. You should never merge master into a PR branch; imagine the commit graph when the PR branch is then merged back into master! :)

Copy link
Author

Choose a reason for hiding this comment

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

Sure, I'll do that instead.

org-super-agenda-deprecated-selectors-alist)))
(let ((old (symbol-name selector))
(new (symbol-name new-selector)))
(display-warning 'org-super-agenda
(concat "Deprecated selector, please use `" new
"' instead of `" old "'"))
(plist-get org-super-agenda-group-types new-selector))))
;; Invalid selector: raise error
((user-error "Invalid org-super-agenda-groups selector: %s" selector))))

(defvar org-super-agenda-deprecated-selectors-alist
'((:date . :timestamp))
"Alist of deprecated selectors and their replacements.")

(defun org-super-agenda--group-dispatch (items group)
"Group ITEMS with the appropriate grouping functions for GROUP.
Expand Down
Loading