Merge 9b32856244 into 4b8330a683

org-ql-search.el

@@ -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))

org-ql-view.el

@@ -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

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
+    (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")))))
+                  (_ (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."

tests/test-org-ql.el

@@ -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")
     ))