summaryrefslogtreecommitdiff
path: root/mu4e/mu4e-labels.el
blob: fd05c4fb91e90aa611832c9285c334797090ba63 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
;;; mu4e-labels.el --- Dealing with labels -*- lexical-binding: t -*-

;; Copyright (C) 2025 Dirk-Jan C. Binnema

;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>

;; This file is not part of GNU Emacs.

;; mu4e is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; mu4e is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with mu4e.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; In this file, add some helpers for dealing with message labels

;;; Code:
(require 'mu4e-message)
(require 'mu4e-server)
(require 'mu4e-helpers)

(defconst mu4e-label-regex
  "[^\"',+/\\`[:cntrl:][:blank:]-][^\"'$,/\\`[:cntrl:][:blank:]]+"
  "Unanchored regular expression matching a valid label.

Any character is allowed that is not a control-character, a
blank, or a number of special characters. Additionally, the first
character cannot be + or - either.")
;; sadly, the 'rx' macro is not expressive enough, pre-emacs30

(defun mu4e-label-validate (str)
  "Validate label STR.

If STR is a valid label, return STR. Otherwise, raise an warning.
This function attempts to be a bit more informative than simply
checking a regular expression.

See `mu4e-label-regex' for the definition of the valid format."
  (when (string-empty-p str) ;; i. must not be empty
    (mu4e-warn "an empty string is a not a valid label"))
  (let ((first (aref str 0))
        ;; anchored
        (valid-rx (rx bos (regex mu4e-label-regex) eos)))
    ;; ii. must not start with + or -
    (when (or (char-equal first ?+) (char-equal first ?-))
      (mu4e-warn "labels cannot starts with '%c'" first))
    ;; iii. match the regexp
    (unless (string-match-p valid-rx str)
      (mu4e-warn "not a valid label: %S" str)))
  str)

(defun mu4e-label-parse-delta-exprs (delta-exprs)
  "Parse a string a DELTA-EXPRS.

If empty, return nil. Otherwise, raise an error if it is invalid.
Otherwise, return a list with the invidual elements."
  (seq-map (lambda (delta-expr)
             (when (string-empty-p delta-expr)
               (mu4e-warn "delta-expression cannot be empty"))
             (let ((op (aref delta-expr 0))
                   (label (substring delta-expr 1)))
               (unless (or (char-equal op ?+) (char-equal op ?-))
                 (mu4e-warn (concat  "labels in delta-expression"
                                     " must start with +/- ('%s')")
                            delta-expr))
               (concat (char-to-string op) (mu4e-label-validate label))))
           (split-string delta-exprs "[,[:space:]]+" t)))

(defvar mu4e-labels-list nil "Cached list of labels.")

(defun mu4e--labels-completion-at-point ()
  "Provide completion when entering a label delta expressions."
  (cond
   ((not (looking-back "[^ \t]*" nil))
    (let ((bounds (bounds-of-thing-at-point 'word)))
      (list (or (car bounds) (point))
            (or (cdr bounds) (point)))))
   ((looking-back
     (rx (any "+" "-")
         (group
          (opt (regex mu4e-label-regex)))) nil)
    (list (match-beginning 1)
          (match-end 1)
          mu4e-labels-list))))

(defvar mu4e-minibuffer-label-expr-map
  (let ((map (copy-keymap minibuffer-local-map)))
    (define-key map (kbd "TAB") #'completion-at-point)
    map)
  "The keymap for reading label delta expression.")

(defun mu4e-labels-delta-read ()
  "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
      (lambda ()
        (setq-local completion-at-point-functions
                    #'mu4e--labels-completion-at-point)
        (use-local-map mu4e-minibuffer-label-expr-map))
    (string-join
     (mu4e-label-parse-delta-exprs
      (read-string "Label delta (+/-) expression: "))
     " ")))

(defun mu4e--labels-update-server (docid expr)
  "Tell the server to update message with DOCID with EXPR.
EXPR is a label delta-expression, such as \"+foo -bar\".

Update the label cache while doing so."
  ;; update the cache
  (let ((deltas (mu4e-label-parse-delta-exprs expr)))
    ;; update cache
    (seq-do (lambda (delta-label)
              (cl-pushnew (substring delta-label 1) mu4e-labels-list))
            deltas)
    ;; maybe pass as list?
    (mu4e--server-label docid (string-join deltas " "))))

(defun mu4e--labels-clear-server (docid)
  "Clear all labels from message with DOCID."
  ;; update the server
  ;; '-*' is not a valid label, but special-cased
  ;; on the server-side
  (mu4e--server-label docid "-*"))


(provide 'mu4e-labels)
;;; mu4e-labels.el ends here