Skip to content

Add :limit keyword support #495

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

Open
alhassy wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Add :limit keyword support #495

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
12 changes: 7 additions & 5 deletions org-ql-search.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -149,7 +149,7 @@ Runs `org-occur-hook' after making the sparse tree."
num-results)))

;;;###autoload
(cl-defun org-ql-search (buffers-files query &key narrow super-groups sort title
(cl-defun org-ql-search (buffers-files query &key narrow super-groups sort title limit
(buffer org-ql-view-buffer))
"Search for QUERY with `org-ql'.
Interactively, prompt for these variables:
Expand Down Expand Up @@ -205,7 +205,8 @@ necessary."
(results (org-ql-select buffers-files query
:action 'element-with-markers
:narrow narrow
:sort sort))
:sort sort
:limit limit))
(strings (-map #'org-ql-view--format-element results))
(buffer (or buffer (format "%s %s*" org-ql-view-buffer-name-prefix (or title query))))
(header (org-ql-view--header-line-format
Expand All @@ -214,6 +215,7 @@ necessary."
(org-ql-view-buffers-files buffers-files)
(org-ql-view-query query)
(org-ql-view-sort sort)
(org-ql-view-limit limit)
(org-ql-view-narrow narrow)
(org-ql-view-super-groups super-groups)
(org-ql-view-title title))
Expand Down Expand Up @@ -242,10 +244,10 @@ automatically from the query."
('nil (org-agenda-files nil 'ifmode))
(_ (prog1 org-agenda-restrict
(with-current-buffer org-agenda-restrict
;; Narrow the buffer; remember to widen it later.
(setf old-beg (point-min) old-end (point-max)
;; Narrow the buffer; remember to widen it later.
(setf old-beg (point-min) old-end (point-max)
narrow-p t)
(narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end))))))
(narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end))))))
(items (org-ql-select from query
:action 'element-with-markers
:narrow narrow-p)))
Expand Down
37 changes: 28 additions & 9 deletions org-ql-view.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -104,6 +104,7 @@ Based on `org-agenda-mode-map'.")
(defvar-local org-ql-view-buffers-files nil)
(defvar-local org-ql-view-query nil)
(defvar-local org-ql-view-sort nil)
(defvar-local org-ql-view-limit nil)
(defvar-local org-ql-view-narrow nil)
(defvar-local org-ql-view-super-groups nil)
(defvar-local org-ql-view-title nil)
Expand Down Expand Up @@ -341,6 +342,7 @@ update search arguments."
(defaults (list org-ql-view-buffers-files
org-ql-view-query
:sort org-ql-view-sort
:limit org-ql-view-limit
:narrow org-ql-view-narrow
:super-groups org-ql-view-super-groups
:title org-ql-view-title))
Expand Down Expand Up @@ -401,6 +403,7 @@ update search arguments."
(list :buffers-files org-ql-view-buffers-files
:query org-ql-view-query
:sort org-ql-view-sort
:limit org-ql-view-limit
:narrow org-ql-view-narrow
:super-groups org-ql-view-super-groups
:title org-ql-view-title)))
Expand Down Expand Up @@ -438,11 +441,11 @@ HEADER is a string displayed in the buffer's header line.
The following special variables, if non-nil, are set
buffer-locally to preserve their value in the buffer for
subsequent refreshing of the buffer: `org-ql-view-buffers-files',
`org-ql-view-query', `org-ql-view-sort', `org-ql-view-narrow',
`org-ql-view-super-groups', `org-ql-title.'"
`org-ql-view-query', `org-ql-view-sort', `org-ql-view-limit',
`org-ql-view-narrow', `org-ql-view-super-groups', `org-ql-title.'"
(declare (indent defun))
(let* ((vars (list 'org-ql-view-buffers-files 'org-ql-view-query
'org-ql-view-sort 'org-ql-view-narrow
'org-ql-view-sort 'org-ql-view-limit 'org-ql-view-narrow
'org-ql-view-super-groups 'org-ql-view-title))
;; Save the values of variables which are set buffer-locally in the
;; results buffer, which we want to override and set buffer-locally again.
Expand Down Expand Up @@ -729,6 +732,8 @@ When opened, the link searches the buffer it's opened from."
(list "super-groups" (prin1-to-string org-ql-view-super-groups)))
(when org-ql-view-sort
(list "sort" (prin1-to-string org-ql-view-sort)))
(when org-ql-view-limit
(list "limit" (prin1-to-string org-ql-view-limit)))
(when org-ql-view-title
(list "title" (prin1-to-string org-ql-view-title)))))
(filename (concat (url-hexify-string query-string)
Expand Down Expand Up @@ -773,6 +778,7 @@ When opened, the link searches the buffer it's opened from."
("q" org-ql-view--transient-query)
("i" org-ql-view--transient-in)
("s" org-ql-view--transient-sort)
("l" org-ql-view--transient-limit)
("g" org-ql-view--transient-super-groups)]]
[["View"
("r" "Refresh" org-ql-view-refresh)
Expand Down Expand Up @@ -866,6 +872,19 @@ When opened, the link searches the buffer it's opened from."
;; FIXME: Figure out how to integrate initial-input and history.
(org-ql-view--complete-sort)))


(transient-define-infix org-ql-view--transient-limit ()
:description (lambda () (org-ql-view--format-transient-key-value "Limit by" org-ql-view-limit))
:class 'org-ql-view--variable
:argument ""
:variable 'org-ql-view-limit
:prompt "Limit: "
:reader (lambda (prompt _initial-input history)
(string-to-number
(read-string prompt (when org-ql-view-limit
(format "%s" org-ql-view-limit))
history))))

;;;; Faces/properties

(defalias 'org-ql-view--resolve-element-properties
Expand Down Expand Up @@ -913,7 +932,7 @@ return an empty string."
;; Adding the relative due date property should probably be done explicitly and separately
;; (which would also make it easier to do it independently of faces, etc).
(title (--> (org-ql-view--add-faces element)
(org-element-property :raw-value it)))
(org-element-property :raw-value it)))
;; TODO(B): Needs refactoring. A function like `org-ql-view--add-faces'
;; should return a list of faces to be added.
(title-faces (get-text-property 0 'face title))
Expand All @@ -939,17 +958,17 @@ return an empty string."
(org-element-property :tags element)))
(tag-string (when tag-list
(--> tag-list
(s-join ":" it)
(s-wrap it ":")
(org-add-props it nil 'face 'org-tag))))
(s-join ":" it)
(s-wrap it ":")
(org-add-props it nil 'face 'org-tag))))
(category (or (org-element-property :CATEGORY element)
(when-let ((marker (or (org-element-property :org-hd-marker element)
(org-element-property :org-marker element))))
(org-with-point-at marker
(or (org-get-category)
(when buffer-file-name
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))))))
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))))))
""))
(priority-string (-some->> (org-element-property :priority element)
(char-to-string)
Expand Down
32 changes: 20 additions & 12 deletions org-ql.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -333,7 +333,7 @@ See Info node `(org-ql)Queries'."
(sxhash-equal (prin1-to-string args))))

;;;###autoload
(cl-defun org-ql-select (buffers-or-files query &key action narrow sort)
(cl-defun org-ql-select (buffers-or-files query &key action narrow sort limit)
"Return items matching QUERY in BUFFERS-OR-FILES.

BUFFERS-OR-FILES is a file or buffer, a list of files and/or
Expand Down Expand Up @@ -368,6 +368,9 @@ arguments and returns nil or non-nil. Sorting methods are
applied in the order given (i.e. later methods override earlier
ones), and `reverse' may be used more than once.

LIMIT is an non-negative integer used to limit the final number of results
produced.

For example, `(date priority)' would present items with the
highest priority first, and within each priority the oldest items
would appear first. In contrast, `(date reverse priority)' would
Expand Down Expand Up @@ -437,17 +440,19 @@ each priority the newest items would appear first."
(-let (((&plist :name :fn) it))
(fset name fn)))))))
;; Sort items
(pcase sort
(`nil items)
((guard (cl-subsetp (-list sort) '(date deadline scheduled closed todo priority random reverse)))
;; Default sorting functions
(org-ql--sort-by items (-list sort)))
;; Sort by user-given comparator.
((pred functionp) (-sort sort items))
(_ (user-error "SORT must be either nil, one or a list of the defined sorting methods (see documentation), or a comparison function of two arguments")))))
(setq items (pcase sort
(`nil items)
((guard (cl-subsetp (-list sort) '(date deadline scheduled closed todo priority random reverse)))
;; Default sorting functions
(org-ql--sort-by items (-list sort)))
;; Sort by user-given comparator.
((pred functionp) (-sort sort items))
(_ (user-error "SORT must be either nil, one or a list of the defined sorting methods (see documentation), or a comparison function of two arguments"))))
;; Limit items
(if limit (-take limit items) items)))

;;;###autoload
(cl-defun org-ql-query (&key (select 'element-with-markers) from where narrow order-by)
(cl-defun org-ql-query (&key (select 'element-with-markers) from where narrow order-by limit)
"Like `org-ql-select', but arguments are named more like a SQL query.

SELECT corresponds to the `org-ql-select' argument ACTION. It is
Expand Down Expand Up @@ -475,12 +480,15 @@ should be an `org-ql' query sexp.
ORDER-BY corresponds to the `org-ql-select' argument SORT, which
see.

NARROW corresponds to the `org-ql-select' argument NARROW."
NARROW corresponds to the `org-ql-select' argument NARROW.

LIMIT corresponds to the `org-ql-select' argument LIMIT."
(declare (indent 0))
(org-ql-select from where
:action select
:narrow narrow
:sort order-by))
:sort order-by
:limit limit))

(defun org-ql--select-cached (&rest args)
"Return results for ARGS and current buffer using cache."
Expand Down
12 changes: 12 additions & 0 deletions tests/test-org-ql.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2359,6 +2359,18 @@ with keyword arg NOW in PLIST."
:buffer link-buffer)
:to-throw 'user-error '("Views that search non-file-backed buffers can't be linked to"))))))

(describe "org-ql-select with :limit"

(it "returns only N results when :limit is given"
(org-ql-expect ('(ancestors))
'("Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "/r/emacs" "Shop for groceries" "Sunrise/sunset" "Rewrite Emacs in Common Lisp" "Write a symphony"))
(org-ql-expect ('(ancestors) :limit 3)
'("Take over the world" "Skype with president of Antarctica" "Take over Mars")))

(it "returns all results when :limit is nil"
(org-ql-expect ('(ancestors) :limit nil)
'("Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "/r/emacs" "Shop for groceries" "Sunrise/sunset" "Rewrite Emacs in Common Lisp" "Write a symphony"))))

;; MAYBE: Also test `org-ql-views', although I already know it works now.
;; (describe "org-ql-views")
))
Expand Down
Loading