Add :limit keyword support
This commit is contained in:
parent
4b8330a683
commit
9b32856244
4 changed files with 67 additions and 26 deletions
|
|
@ -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:
|
||||
|
|
@ -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
|
||||
|
|
@ -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))
|
||||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
@ -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))
|
||||
|
|
@ -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)))
|
||||
|
|
@ -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.
|
||||
|
|
@ -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)
|
||||
|
|
@ -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)
|
||||
|
|
@ -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
|
||||
|
|
@ -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))
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
32
org-ql.el
32
org-ql.el
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue