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
| | ;; notmuch-tagger.el --- Library to improve the way tags are displayed
;;
;; Copyright © Damien Cassou
;;
;; This file is part of Notmuch.
;;
;; Notmuch 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.
;;
;; Notmuch 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 Notmuch. If not, see <http://www.gnu.org/licenses/>.
;;
;; Authors: Damien Cassou <damien.cassou@gmail.com>
;;; Commentary:
;;
;;; Code:
;;
(defun notmuch-tagger-header-button-present-p ()
"Check if `header-button' can be loaded or is already loaded.
`header-button' is a third-party library which facilitates the
creation of links in emacs header-line. This function tries to
`require' `header-button' and returns nil if and only if this
fails."
(require 'header-button nil t))
(defun notmuch-tagger-goto-target (tag)
"Show a `notmuch-search' buffer for the TAG."
(notmuch-search (concat "tag:\"" tag "\"")))
(defun notmuch-tagger-header-button-action (button)
"Open `notmuch-search' for the tag referenced by BUTTON.
This function depends on the presence of the `header-button'
library. Please call `notmuch-tagger-header-button-present-p' to
test if the library is present before calling this function."
(let ((tag (header-button-get button 'notmuch-tagger-tag)))
(notmuch-tagger-goto-target tag)))
(defun notmuch-tagger-body-button-action (button)
"Open `notmuch-search' for the tag referenced by BUTTON."
(let ((tag (button-get button 'notmuch-tagger-tag)))
(notmuch-tagger-goto-target tag)))
(eval-after-load "header-button"
'(define-button-type 'notmuch-tagger-header-button-type
'supertype 'header
'action #'notmuch-tagger-header-button-action
'follow-link t))
(define-button-type 'notmuch-tagger-body-button-type
'action #'notmuch-tagger-body-button-action
'follow-link t)
(defun notmuch-tagger-really-make-header-link (tag)
"Return a property list that presents a link to TAG.
The returned property list will only work in the header-line.
Additionally, this function depends on the presence of the
`header-button' library. Please call
`notmuch-tagger-header-button-present-p' to test if library is
present before calling this function."
(header-button-format
tag
:type 'notmuch-tagger-header-button-type
'notmuch-tagger-tag tag
'help-echo (format "%s: Search other messages like this" tag)))
(defun notmuch-tagger-make-header-link (tag)
"Return a property list to present TAG as a link to search.
This only works if `header-button' is loaded. Simply returns tag
if not."
(if (notmuch-tagger-header-button-present-p)
(notmuch-tagger-really-make-header-link tag)
tag))
(defun notmuch-tagger-make-body-link (tag)
"Return a property list that presents a link to TAG.
The returned property list will not work in the header-line. For
a link that works on the header-line, prefer
`notmuch-tagger-make-header-link'."
(let ((button (copy-sequence tag)))
(make-text-button
button nil
'type 'notmuch-tagger-body-button-type
'notmuch-tagger-tag tag
'skip t ;; don't stop when using TAB
'help-echo (format "%s: Search other messages like this" tag))
button))
(defun notmuch-tagger-format-tags-header-line (tags)
"Format TAGS as a `mode-line-format' template.
The result is suitable for inclusion in `header-line-format'."
(list
"("
(notmuch-intersperse
(mapcar #'notmuch-tagger-make-header-link tags)
" ")
")"))
(defun notmuch-tagger-format-tags (tags)
"Format TAGS as a string suitable for insertion in a buffer.
If the result of this function is to be used within the
header-line, prefer `notmuch-tagger-format-tags-header-line'
instead of this function."
(concat
"("
(mapconcat #'notmuch-tagger-make-body-link tags " ")
")"))
(provide 'notmuch-tagger)
;;; notmuch-tagger.el ends here
|