Tidy: Use -let* instead of pcase-let* for plists

This actually only fixes a problem with running the tests, because I
don't have a way to force map-2.1 to be installed into the sandbox, so
the tests on CI always fail.  So for now we just use -let* for this.
This commit is contained in:
Adam Porter 2020-11-16 03:49:46 -06:00
parent faaa6f7ee9
commit c07971cd57
2 changed files with 40 additions and 40 deletions

View file

@ -272,35 +272,35 @@ Valid parameters include:
For example, an org-ql dynamic block header could look like:
#+BEGIN: org-ql :query (todo \"UNDERWAY\") :columns (priority todo heading) :sort (priority date) :ts-format \"%Y-%m-%d %H:%M\""
(pcase-let* (((map :query :columns :sort :ts-format :take) params)
(query (cl-etypecase query
(string (org-ql--plain-query query))
(t query)))
(columns (or columns '(heading todo (priority "P"))))
;; MAYBE: Custom column functions.
(format-fns
;; NOTE: Backquoting this alist prevents the lambdas from seeing
;; the variable `ts-format', so we use `list' and `cons'.
(list (cons 'todo (lambda (element)
(org-element-property :todo-keyword element)))
(cons 'heading (lambda (element)
(org-make-link-string (org-element-property :raw-value element)
(org-element-property :raw-value element))))
(cons 'priority (lambda (element)
(--when-let (org-element-property :priority element)
(char-to-string it))))
(cons 'deadline (lambda (element)
(--when-let (org-element-property :deadline element)
(ts-format ts-format (ts-parse-org-element it)))))
(cons 'scheduled (lambda (element)
(--when-let (org-element-property :scheduled element)
(ts-format ts-format (ts-parse-org-element it)))))
(cons 'property (lambda (element property)
(org-element-property (intern (concat ":" (upcase property))) element)))))
(elements (org-ql-query :from (current-buffer)
:where query
:select '(org-element-headline-parser (line-end-position))
:order-by sort)))
(-let* (((&plist :query :columns :sort :ts-format :take) params)
(query (cl-etypecase query
(string (org-ql--plain-query query))
(t query)))
(columns (or columns '(heading todo (priority "P"))))
;; MAYBE: Custom column functions.
(format-fns
;; NOTE: Backquoting this alist prevents the lambdas from seeing
;; the variable `ts-format', so we use `list' and `cons'.
(list (cons 'todo (lambda (element)
(org-element-property :todo-keyword element)))
(cons 'heading (lambda (element)
(org-make-link-string (org-element-property :raw-value element)
(org-element-property :raw-value element))))
(cons 'priority (lambda (element)
(--when-let (org-element-property :priority element)
(char-to-string it))))
(cons 'deadline (lambda (element)
(--when-let (org-element-property :deadline element)
(ts-format ts-format (ts-parse-org-element it)))))
(cons 'scheduled (lambda (element)
(--when-let (org-element-property :scheduled element)
(ts-format ts-format (ts-parse-org-element it)))))
(cons 'property (lambda (element property)
(org-element-property (intern (concat ":" (upcase property))) element)))))
(elements (org-ql-query :from (current-buffer)
:where query
:select '(org-element-headline-parser (line-end-position))
:order-by sort)))
(when take
(setf elements (cl-etypecase take
((and integer (satisfies cl-minusp)) (-take-last (abs take) elements))

View file

@ -550,8 +550,8 @@ dates in the past, and negative for dates in the future."
(when (buffer-base-buffer b-f)
(buffer-file-name (buffer-base-buffer b-f)))))
(t (user-error "Only file-backed buffers can be bookmarked by Org QL View: %s" b-f)))))
(pcase-let* ((plist (org-ql-view--plist (current-buffer)))
((map :buffers-files) plist))
(-let* ((plist (org-ql-view--plist (current-buffer)))
((&plist :buffers-files) plist))
;; Replace buffers with their filenames, and signal error if any are not file-backed.
(setf plist (plist-put plist :buffers-files
(cl-etypecase buffers-files
@ -566,15 +566,15 @@ dates in the past, and negative for dates in the future."
;;;###autoload
(defun org-ql-view-bookmark-handler (bookmark)
"Show Org QL View BOOKMARK in current buffer."
;; FIXME: Getting "(void-variable super-groups)" errors when this function is byte-compiled,
;; but not when it's interpreted! Using (:super-groups super-groups) instead of just
;; :super-groups fixes it, but I have no idea why, and the macroexpansion is the same.
(pcase-let* (((map org-ql-view-plist) (bookmark-get-bookmark-record bookmark))
((map :buffers-files :query :super-groups :narrow :sort :title)
org-ql-view-plist)
(super-groups (cl-etypecase super-groups
(symbol (symbol-value super-groups))
(list super-groups))))
;; FIXME: `pcase-let*' is easier to use to destructure this, but if I use
;; that, I want to use map 2.1 for the extra convenience, but I can't force
;; that to be installed into the makem.sh sandbox, so I just use `-let*' here.
(-let* ((org-ql-view-plist (car (bookmark-get-bookmark-record bookmark)))
((&plist :buffers-files :query :super-groups :narrow :sort :title)
(cdr org-ql-view-plist))
(super-groups (cl-etypecase super-groups
(symbol (symbol-value super-groups))
(list super-groups))))
(org-ql-search buffers-files query
:super-groups super-groups :narrow narrow :sort sort :title title)
;; HACK: `bookmark--jump-via' expects that, when the handler returns, the current buffer