mu4e: labels tweaks
Make the code a little clearer, and catch error earlier. Allow for comma-separated labels.
This commit is contained in:
@ -30,21 +30,13 @@
|
|||||||
(require 'mu4e-helpers)
|
(require 'mu4e-helpers)
|
||||||
|
|
||||||
(defconst mu4e-label-regex
|
(defconst mu4e-label-regex
|
||||||
"[^\"'+/\\`[:cntrl:][:blank:]-][^\"'/\\`[:cntrl:][:blank:]]*"
|
"[^\"',+/\\`[:cntrl:][:blank:]-][^\"'$,/\\`[:cntrl:][:blank:]]+"
|
||||||
;;Emacs 30:
|
|
||||||
;;(rx-let ((taboo (any cntrl blank "\"'\\/`$"))
|
|
||||||
;; (taboo1-extra (any "-+")))
|
|
||||||
;; (rx (seq
|
|
||||||
;; ;; First character: base forbidden + extra chars
|
|
||||||
;; (not (or taboo taboo1-extra))
|
|
||||||
;; ;; Rest: just base forbidden chars
|
|
||||||
;; (zero-or-more (not taboo)))))
|
|
||||||
"Unanchored regular expression matching a valid label.
|
"Unanchored regular expression matching a valid label.
|
||||||
|
|
||||||
Any character is allowed that is not a control-character, a
|
Any character is allowed that is not a control-character, a
|
||||||
blank, or ASCII single/double quotes,backtick or
|
blank, or a number of special characters. Additionally, the first
|
||||||
forward/backward slash; additionally, the first character cannot
|
character cannot be + or - either.")
|
||||||
be a \"+\" or \"-\", \"$\" either.")
|
;; sadly, the 'rx' macro is not expressive enough, pre-emacs30
|
||||||
|
|
||||||
(defun mu4e-label-validate (str)
|
(defun mu4e-label-validate (str)
|
||||||
"Validate label STR.
|
"Validate label STR.
|
||||||
@ -55,45 +47,34 @@ checking a regular expression.
|
|||||||
|
|
||||||
See `mu4e-label-regex' for the definition of the valid format."
|
See `mu4e-label-regex' for the definition of the valid format."
|
||||||
(when (string-empty-p str) ;; i. must not be empty
|
(when (string-empty-p str) ;; i. must not be empty
|
||||||
(mu4e-warn "invalid: empty string"))
|
(mu4e-warn "an empty string is a not a valid label"))
|
||||||
(let ((first (aref str 0)))
|
(let ((first (aref str 0))
|
||||||
|
;; anchored
|
||||||
|
(valid-rx (rx bos (regex mu4e-label-regex) eos)))
|
||||||
;; ii. must not start with + or -
|
;; ii. must not start with + or -
|
||||||
(when (or (char-equal first ?+) (char-equal first ?-))
|
(when (or (char-equal first ?+) (char-equal first ?-))
|
||||||
(mu4e-warn "invalid: starts with '%c'" first))
|
(mu4e-warn "labels cannot starts with '%c'" first))
|
||||||
;; iii. check all characters a valid:
|
;; iii. match the regexp
|
||||||
(seq-do (lambda (kar)
|
(unless (string-match-p valid-rx str)
|
||||||
(unless (string-match-p mu4e-label-regex
|
(mu4e-warn "not a valid label: %S" str)))
|
||||||
(string ?_ kar))
|
|
||||||
(mu4e-warn "invalid: character '%c'" kar)))
|
|
||||||
str))
|
|
||||||
str)
|
str)
|
||||||
|
|
||||||
(defun mu4e-label-parse-expr (expr)
|
(defun mu4e-label-parse-delta-exprs (delta-exprs)
|
||||||
"Parse a single delta expression EXPR.
|
"Parse a string a DELTA-EXPRS.
|
||||||
|
|
||||||
If EXPR is non-empty, raises a warning if EXPR is not a valid
|
If empty, return nil. Otherwise, raise an error if it is invalid.
|
||||||
delta expression. Otherwise, returns EXPR with extra whitespace
|
Otherwise, return a list with the invidual elements."
|
||||||
removed.
|
(seq-map (lambda (delta-expr)
|
||||||
|
(when (string-empty-p delta-expr)
|
||||||
If STR is empty, return nil."
|
(mu4e-warn "delta-expression cannot be empty"))
|
||||||
(let ((op (aref expr 0))
|
(let ((op (aref delta-expr 0))
|
||||||
(label (substring expr 1)))
|
(label (substring delta-expr 1)))
|
||||||
;; guess we could _imply_ '+', but for now let's not
|
(unless (or (char-equal op ?+) (char-equal op ?-))
|
||||||
;; be too magical.
|
(mu4e-warn (concat "labels in delta-expression"
|
||||||
(unless (or (char-equal op ?+) (char-equal op ?-))
|
" must start with +/- ('%s')")
|
||||||
(mu4e-warn "delta-expressions must start with + or - ('%s')"
|
delta-expr))
|
||||||
expr))
|
(concat (char-to-string op) (mu4e-label-validate label))))
|
||||||
(concat (char-to-string op)
|
(split-string delta-exprs "[,[:space:]]+" t)))
|
||||||
(mu4e-label-validate label))))
|
|
||||||
|
|
||||||
(defun mu4e-label-parse-exprs (exprs)
|
|
||||||
"Parse a string EXPRS with deltas to a string.
|
|
||||||
|
|
||||||
If EXPRS is non-empty, raises an error if EXPRS is invalid.
|
|
||||||
Otherwise, return EXPRS with extra whitespace removed.
|
|
||||||
|
|
||||||
If EXPRS is empty, return nil."
|
|
||||||
(mapconcat #'mu4e-label-parse-expr (split-string exprs) " "))
|
|
||||||
|
|
||||||
(defvar mu4e-labels-list nil "Cached list of labels.")
|
(defvar mu4e-labels-list nil "Cached list of labels.")
|
||||||
|
|
||||||
@ -119,14 +100,20 @@ If EXPRS is empty, return nil."
|
|||||||
"The keymap for reading label delta expression.")
|
"The keymap for reading label delta expression.")
|
||||||
|
|
||||||
(defun mu4e-labels-delta-read ()
|
(defun mu4e-labels-delta-read ()
|
||||||
"Ask for a labels delta expression."
|
"Ask for a label delta +/ expression.
|
||||||
|
|
||||||
|
I.e., a sequence of 1 or more space-separated labels, each
|
||||||
|
prefixed with \"+\" for addding the label, or \"-\" for removing
|
||||||
|
it."
|
||||||
(minibuffer-with-setup-hook
|
(minibuffer-with-setup-hook
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(setq-local completion-at-point-functions
|
(setq-local completion-at-point-functions
|
||||||
#'mu4e--labels-completion-at-point)
|
#'mu4e--labels-completion-at-point)
|
||||||
(use-local-map mu4e-minibuffer-label-expr-map))
|
(use-local-map mu4e-minibuffer-label-expr-map))
|
||||||
(mu4e-label-parse-exprs
|
(string-join
|
||||||
(read-string "Label delta expression: "))))
|
(mu4e-label-parse-delta-exprs
|
||||||
|
(read-string "Label delta (+/-) expression: "))
|
||||||
|
" ")))
|
||||||
|
|
||||||
(defun mu4e--labels-update-server (docid expr)
|
(defun mu4e--labels-update-server (docid expr)
|
||||||
"Tell the server to update message with DOCID with EXPR.
|
"Tell the server to update message with DOCID with EXPR.
|
||||||
@ -134,18 +121,13 @@ EXPR is a label delta-expression, such as \"+foo -bar\".
|
|||||||
|
|
||||||
Update the label cache while doing so."
|
Update the label cache while doing so."
|
||||||
;; update the cache
|
;; update the cache
|
||||||
(let ((expr (mu4e-label-parse-exprs expr))
|
(let ((deltas (mu4e-label-parse-delta-exprs expr)))
|
||||||
(labels ;; the list of labels without +/- prefix
|
;; update cache
|
||||||
(seq-map (lambda (pmlabel)
|
(seq-do (lambda (delta-label)
|
||||||
(substring pmlabel 1))
|
(cl-pushnew (substring delta-label 1) mu4e-labels-list))
|
||||||
(split-string expr " "))))
|
deltas)
|
||||||
;; don't care about dups etc.; the list
|
;; maybe pass as list?
|
||||||
;; will be replaced by a fresh server-side one, after
|
(mu4e--server-label docid (string-join deltas " "))))
|
||||||
;; update / restart
|
|
||||||
(setq mu4e-labels-list
|
|
||||||
(append labels mu4e-labels-list))
|
|
||||||
;; update the server
|
|
||||||
(mu4e--server-label docid expr)))
|
|
||||||
|
|
||||||
(defun mu4e--labels-clear-server (docid)
|
(defun mu4e--labels-clear-server (docid)
|
||||||
"Clear all labels from message with DOCID."
|
"Clear all labels from message with DOCID."
|
||||||
|
|||||||
@ -329,11 +329,6 @@ The following marks are available, and the corresponding props:
|
|||||||
(when (mu4e-create-maildir-maybe fulltarget)
|
(when (mu4e-create-maildir-maybe fulltarget)
|
||||||
target)))
|
target)))
|
||||||
|
|
||||||
(defun mu4e--mark-get-labels-target ()
|
|
||||||
"Ask for a labels expression."
|
|
||||||
(let* ((exprs (read-from-minibuffer "Label expression: ")))
|
|
||||||
(mu4e-label-parse-exprs exprs)))
|
|
||||||
|
|
||||||
(defun mu4e--mark-ask-target (mark)
|
(defun mu4e--mark-ask-target (mark)
|
||||||
"Ask the target for MARK, if the user should be asked the target."
|
"Ask the target for MARK, if the user should be asked the target."
|
||||||
(let ((getter (plist-get (cdr (assq mark mu4e-marks)) :ask-target)))
|
(let ((getter (plist-get (cdr (assq mark mu4e-marks)) :ask-target)))
|
||||||
|
|||||||
Reference in New Issue
Block a user