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: 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\"" #+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) (-let* (((&plist :query :columns :sort :ts-format :take) params)
(query (cl-etypecase query (query (cl-etypecase query
(string (org-ql--plain-query query)) (string (org-ql--plain-query query))
(t query))) (t query)))
(columns (or columns '(heading todo (priority "P")))) (columns (or columns '(heading todo (priority "P"))))
;; MAYBE: Custom column functions. ;; MAYBE: Custom column functions.
(format-fns (format-fns
;; NOTE: Backquoting this alist prevents the lambdas from seeing ;; NOTE: Backquoting this alist prevents the lambdas from seeing
;; the variable `ts-format', so we use `list' and `cons'. ;; the variable `ts-format', so we use `list' and `cons'.
(list (cons 'todo (lambda (element) (list (cons 'todo (lambda (element)
(org-element-property :todo-keyword element))) (org-element-property :todo-keyword element)))
(cons 'heading (lambda (element) (cons 'heading (lambda (element)
(org-make-link-string (org-element-property :raw-value element) (org-make-link-string (org-element-property :raw-value element)
(org-element-property :raw-value element)))) (org-element-property :raw-value element))))
(cons 'priority (lambda (element) (cons 'priority (lambda (element)
(--when-let (org-element-property :priority element) (--when-let (org-element-property :priority element)
(char-to-string it)))) (char-to-string it))))
(cons 'deadline (lambda (element) (cons 'deadline (lambda (element)
(--when-let (org-element-property :deadline element) (--when-let (org-element-property :deadline element)
(ts-format ts-format (ts-parse-org-element it))))) (ts-format ts-format (ts-parse-org-element it)))))
(cons 'scheduled (lambda (element) (cons 'scheduled (lambda (element)
(--when-let (org-element-property :scheduled element) (--when-let (org-element-property :scheduled element)
(ts-format ts-format (ts-parse-org-element it))))) (ts-format ts-format (ts-parse-org-element it)))))
(cons 'property (lambda (element property) (cons 'property (lambda (element property)
(org-element-property (intern (concat ":" (upcase property))) element))))) (org-element-property (intern (concat ":" (upcase property))) element)))))
(elements (org-ql-query :from (current-buffer) (elements (org-ql-query :from (current-buffer)
:where query :where query
:select '(org-element-headline-parser (line-end-position)) :select '(org-element-headline-parser (line-end-position))
:order-by sort))) :order-by sort)))
(when take (when take
(setf elements (cl-etypecase take (setf elements (cl-etypecase take
((and integer (satisfies cl-minusp)) (-take-last (abs take) elements)) ((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) (when (buffer-base-buffer b-f)
(buffer-file-name (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))))) (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))) (-let* ((plist (org-ql-view--plist (current-buffer)))
((map :buffers-files) plist)) ((&plist :buffers-files) plist))
;; Replace buffers with their filenames, and signal error if any are not file-backed. ;; Replace buffers with their filenames, and signal error if any are not file-backed.
(setf plist (plist-put plist :buffers-files (setf plist (plist-put plist :buffers-files
(cl-etypecase buffers-files (cl-etypecase buffers-files
@ -566,15 +566,15 @@ dates in the past, and negative for dates in the future."
;;;###autoload ;;;###autoload
(defun org-ql-view-bookmark-handler (bookmark) (defun org-ql-view-bookmark-handler (bookmark)
"Show Org QL View BOOKMARK in current buffer." "Show Org QL View BOOKMARK in current buffer."
;; FIXME: Getting "(void-variable super-groups)" errors when this function is byte-compiled, ;; FIXME: `pcase-let*' is easier to use to destructure this, but if I use
;; but not when it's interpreted! Using (:super-groups super-groups) instead of just ;; that, I want to use map 2.1 for the extra convenience, but I can't force
;; :super-groups fixes it, but I have no idea why, and the macroexpansion is the same. ;; that to be installed into the makem.sh sandbox, so I just use `-let*' here.
(pcase-let* (((map org-ql-view-plist) (bookmark-get-bookmark-record bookmark)) (-let* ((org-ql-view-plist (car (bookmark-get-bookmark-record bookmark)))
((map :buffers-files :query :super-groups :narrow :sort :title) ((&plist :buffers-files :query :super-groups :narrow :sort :title)
org-ql-view-plist) (cdr org-ql-view-plist))
(super-groups (cl-etypecase super-groups (super-groups (cl-etypecase super-groups
(symbol (symbol-value super-groups)) (symbol (symbol-value super-groups))
(list super-groups)))) (list super-groups))))
(org-ql-search buffers-files query (org-ql-search buffers-files query
:super-groups super-groups :narrow narrow :sort sort :title title) :super-groups super-groups :narrow narrow :sort sort :title title)
;; HACK: `bookmark--jump-via' expects that, when the handler returns, the current buffer ;; HACK: `bookmark--jump-via' expects that, when the handler returns, the current buffer