Skip to content

Commit

Permalink
Tidy: Compilation warnings, etc, and use compat
Browse files Browse the repository at this point in the history
  • Loading branch information
@alphapapa
alphapapa committed Sep 23, 2023
1 parent b6a7340 commit c5fbb76
Showing 1 changed file with 74 additions and 63 deletions.
137 changes: 74 additions & 63 deletions org-super-agenda.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
;; Author: Adam Porter <[email protected]>
;; Url: http://github.com/alphapapa/org-super-agenda
;; Version: 1.3-pre
;; Package-Requires: ((emacs "26.1") (s "1.10.0") (dash "2.13") (org "9.0") (ht "2.2") (ts "0.2"))
;; Package-Requires: ((emacs "26.1") (compat "29.1.4.1") (s "1.10.0") (dash "2.13") (org "9.0") (ht "2.2") (ts "0.2"))
;; Keywords: hypermedia, outlines, Org, agenda

;;; Commentary:
Expand Down Expand Up @@ -65,7 +65,7 @@
;; (:todo "WAITING" :order 8) ; Set order of this section
;; (:todo ("SOMEDAY" "TO-READ" "CHECK" "TO-WATCH" "WATCHING")
;; ;; Show this group at the end of the agenda (since it has the
;; ;; highest number). If you specified this group last, items
;; ;; highest number). If you specified this group last, items
;; ;; with these todo keywords that e.g. have priority A would be
;; ;; displayed in that group instead, because items are grouped
;; ;; out in the order the groups are listed.
Expand Down Expand Up @@ -185,7 +185,7 @@ disabled. This sets the INHERIT argument to `org-entry-get'."
:type 'string)

(defcustom org-super-agenda-unmatched-order 99
"Default order setting for agenda section containing items unmatched by any filter."
"Default order for section containing items unmatched by any filter."
:type 'integer)

(defcustom org-super-agenda-header-separator "\n"
Expand Down Expand Up @@ -270,8 +270,8 @@ If ANY is non-nil, return as soon as FORM returns non-nil."
A and B are Org timestamp elements."
;; Copied from `org-ql'.
(cl-macrolet ((ts (ts)
`(when ,ts
(org-timestamp-format ,ts "%s"))))
`(when ,ts
(org-timestamp-format ,ts "%s"))))
(let* ((a-ts (ts a))
(b-ts (ts b)))
(cond ((and a-ts b-ts)
Expand Down Expand Up @@ -336,7 +336,7 @@ marker."

;;;###autoload
(define-minor-mode org-super-agenda-mode
"Global minor mode to group items in Org agenda views according to `org-super-agenda-groups'.
"Group items in Org agenda views according to `org-super-agenda-groups'.
With prefix argument ARG, turn on if positive, otherwise off."
:global t
(let ((advice-function-filter-return (if org-super-agenda-mode
Expand Down Expand Up @@ -385,10 +385,10 @@ with the function, which is used by the dispatcher.
DOCSTRING is a string used for the function's docstring.
:SECTION-NAME is a string or a lisp form that is run once, with
:SECTION-NAME is a string or a Lisp form that is run once, with
the variable `items' available.
:TEST is a lisp form that is run for each item, with the variable
:TEST is a Lisp form that is run for each item, with the variable
`item' available. Items passing this test are filtered into a
separate list.
Expand Down Expand Up @@ -548,6 +548,8 @@ COMPARISON should be a symbol, one of: `past' or `before',
;;;;; Effort

(cl-defmacro org-super-agenda--defeffort-group (name docstring &key comparator)
"Define an `org-super-agenda' effort group.
Uses NAME, DOCSTRING, and COMPARATOR."
(declare (indent defun))
`(org-super-agenda--defgroup ,(intern (concat "effort" (symbol-name name)))
,(concat docstring "\nArgument is a time-duration string, like \"5\" or \"0:05\" for 5 minutes.")
Expand Down Expand Up @@ -687,11 +689,11 @@ available."
(error "Unsafe groups disallowed (:pred): %s" args))
(concat "Predicate: "
(cl-labels ((to-string (arg)
(pcase-exhaustive arg
;; FIXME: What if the lambda's byte-compiled?
(`(lambda . ,_) "Lambda")
((pred functionp) (symbol-name arg))
((pred listp) (s-join " OR " (-map #'to-string arg))))))
(pcase-exhaustive arg
;; FIXME: What if the lambda's byte-compiled?
(`(lambda . ,_) "Lambda")
((pred functionp) (symbol-name arg))
((pred listp) (s-join " OR " (-map #'to-string arg))))))
(to-string args))))
:test (pcase args
((pred functionp) (funcall args item))
Expand All @@ -715,13 +717,13 @@ test the value."
(car-safe args)
org-super-agenda-properties-inherit)))
(pcase args
((or (and property (pred stringp))
`(,(and property (pred stringp)) . nil))
((or (and _property (pred stringp))
`(,(and _property (pred stringp)) . nil))
;; Only property, no value given.
t)
(`(,property ,(and value (pred stringp)))
(`(,_property ,(and value (pred stringp)))
(string= value found-value))
(`(,property ,(and predicate (pred functionp)))
(`(,_property ,(and predicate (pred functionp)))
(funcall predicate found-value))
(_ ;; Oops
(signal 'org-super-agenda-invalid-selector (list (cons :property args)))))))
Expand Down Expand Up @@ -788,6 +790,8 @@ e.g. \"A\" or (\"B\" \"C\")."
:test (cl-member (org-super-agenda--get-priority-cookie item) args :test 'string=))

(cl-defmacro org-super-agenda--defpriority-group (name docstring &key comparator)
"Define a priority group.
Uses NAME, DOCSTRING, and COMPARATOR."
(declare (indent defun))
`(org-super-agenda--defgroup ,(intern (concat "priority" (symbol-name name)))
,(concat docstring "\nArgument is a string; it may also be a list of
Expand Down Expand Up @@ -905,11 +909,14 @@ The string should be the priority cookie letter, e.g. \"A\".")
(header-form 'key) (key-sort-fn #'string<))
"Define an auto-grouping function.
The function will be named `org-super-agenda--auto-group-NAME'.
The function will be named `org-super-agenda--auto-group-NAME',
according to NAME.
The docstring will be, \"Divide ALL-ITEMS into groups based on DOCSTRING_ENDING.\".
The docstring will be,
\"Divide ALL-ITEMS into groups based on DOCSTRING-ENDING.\".
The selector keyword will be `:auto-NAME'.
The selector keyword will be KEYWORD, or `:auto-NAME' if KEYWORD
is nil.
Items will be grouped by the value of KEY-FORM evaluated for each
item, with the variable `item' bound to the string from the
Expand All @@ -927,10 +934,10 @@ bound to all agenda items being grouped, and `args' to the rest
of the arguments to the function."
(declare (indent defun))
(cl-labels ((form-contains (form symbol)
(cl-typecase form
(atom (eq form symbol))
(list (or (form-contains (car form) symbol)
(form-contains (cdr form) symbol))))))
(cl-typecase form
(atom (eq form symbol))
(list (or (form-contains (car form) symbol)
(form-contains (cdr form) symbol))))))
(let* ((fn-name (intern (format "org-super-agenda--auto-group-%s" name)))
(docstring (format "Divide ALL-ITEMS into groups based on %s." docstring-ending))
(keyword (or keyword (intern (format ":auto-%s" name))))
Expand Down Expand Up @@ -961,7 +968,8 @@ of the arguments to the function."
;; auto-week, etc. Maybe also auto-next-7-days, something like that.

(org-super-agenda--def-auto-group planning
"their earliest deadline or scheduled date (formatted according to `org-super-agenda-date-format', which see)"
"their earliest deadline or scheduled date.
Formatted according to `org-super-agenda-date-format', which see."
:keyword :auto-planning
;; This is convoluted, mainly because dates and times in Emacs are kind of
;; insane. Good luck parsing a simple "%e %B %Y"-formatted time back to a
Expand All @@ -971,14 +979,14 @@ of the arguments to the function."
;; properties of the formatted time.
;; TODO: Use `ts' for this.
:key-form (cl-flet ((get-date-type (type)
(when-let* ((date-string (org-entry-get (point) type)))
(with-temp-buffer
;; FIXME: Hack: since we're using (org-element-property
;; :type date-element) below, we need this date parsed
;; into an org-element element.
(insert date-string)
(goto-char 0)
(org-element-timestamp-parser)))))
(when-let* ((date-string (org-entry-get (point) type)))
(with-temp-buffer
;; FIXME: Hack: since we're using (org-element-property
;; :type date-element) below, we need this date parsed
;; into an org-element element.
(insert date-string)
(goto-char 0)
(org-element-timestamp-parser)))))
(org-super-agenda--when-with-marker-buffer (org-super-agenda--get-marker item)
;; MAYBE: Also check CLOSED date.
(let ((earliest-ts (car (sort (list (get-date-type "SCHEDULED")
Expand All @@ -1002,7 +1010,8 @@ of the arguments to the function."
:key-sort-fn string<)

(org-super-agenda--def-auto-group ts
"the date of their latest timestamp anywhere in the entry (formatted according to `org-super-agenda-date-format', which see)"
"the date of latest timestamp in the entry.
Formatted according to `org-super-agenda-date-format', which see."
:keyword :auto-ts
:key-form (org-super-agenda--when-with-marker-buffer (org-super-agenda--get-marker item)
(ignore args)
Expand Down Expand Up @@ -1035,7 +1044,9 @@ of the arguments to the function."
(org-get-category))
:header-form (concat "Category: " key))

(org-super-agenda--def-auto-group map "the value returned by calling function ARGS with each item. The function should return a string to be used as the grouping key and as the header for its group"
(org-super-agenda--def-auto-group map "the value of ARGS called with each item.
The function should return a string to be used as the grouping
key and as the header for its group."
:key-form (progn
(unless org-super-agenda-allow-unsafe-groups
;; This check gets run for every item because the `def-auto-group' macro
Expand Down Expand Up @@ -1237,37 +1248,37 @@ Should be done after `org-agenda-finalize' or
(cl-labels ((header-p () (org-get-at-bol 'org-super-agenda-header))
(grid-p () (not (cl-intersection
'(org-agenda-structural-header org-agenda-date-header org-super-agenda-header type)
(text-properties-at (point-at-bol)))))
(text-properties-at (pos-bol)))))
(group-item-visible-p () (and (org-get-at-bol 'type) (not (org-get-at-bol 'invisible))))
(next-header
() (let ((hide-p t) header grid-end)
(while (not (or (bobp) header))
(cond ((header-p)
(setq header (list (1- (or (previous-single-property-change
(point-at-eol) 'org-super-agenda-header)
(1+ (point-min))))
(or grid-end (point-at-eol))
hide-p)))
((group-item-visible-p)
(setq hide-p nil))
((and (grid-p) (not grid-end))
(setq grid-end (point-at-eol))))
(beginning-of-line 0))
header))
() (let ((hide-p t) header grid-end)
(while (not (or (bobp) header))
(cond ((header-p)
(setq header (list (1- (or (previous-single-property-change
(pos-eol) 'org-super-agenda-header)
(1+ (point-min))))
(or grid-end (pos-eol))
hide-p)))
((group-item-visible-p)
(setq hide-p nil))
((and (grid-p) (not grid-end))
(setq grid-end (pos-eol))))
(beginning-of-line 0))
header))
(hide-or-show-header
(header) (when header
(cl-loop
with (start end hide-p) = header
with props = '(invisible org-filtered org-filter-type org-super-agenda-filtered)
initially do (goto-char end)
while (and start (> (point) start))
do (when (or (grid-p) (header-p))
(let ((beg (1- (point-at-bol)))
(end (point-at-eol)))
(if hide-p
(add-text-properties beg end props)
(remove-text-properties beg end props))))
(beginning-of-line 0)))))
(header) (when header
(cl-loop
with (start end hide-p) = header
with props = '(invisible org-filtered org-filter-type org-super-agenda-filtered)
initially do (goto-char end)
while (and start (> (point) start))
do (when (or (grid-p) (header-p))
(let ((beg (1- (pos-bol)))
(end (pos-eol)))
(if hide-p
(add-text-properties beg end props)
(remove-text-properties beg end props))))
(beginning-of-line 0)))))
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-max))
Expand Down

0 comments on commit c5fbb76

Please sign in to comment.