1 Return-Path: <dme@dme.org>
\r
2 X-Original-To: notmuch@notmuchmail.org
\r
3 Delivered-To: notmuch@notmuchmail.org
\r
4 Received: from localhost (localhost [127.0.0.1])
\r
5 by olra.theworths.org (Postfix) with ESMTP id A2F2E40DF1E
\r
6 for <notmuch@notmuchmail.org>; Fri, 19 Nov 2010 09:52:56 -0800 (PST)
\r
7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org
\r
11 X-Spam-Status: No, score=-1.9 tagged_above=-999 required=5
\r
12 tests=[BAYES_00=-1.9, RCVD_IN_DNSWL_NONE=-0.0001] autolearn=ham
\r
13 Received: from olra.theworths.org ([127.0.0.1])
\r
14 by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)
\r
15 with ESMTP id f3xlN6U7Xh1Y for <notmuch@notmuchmail.org>;
\r
16 Fri, 19 Nov 2010 09:52:45 -0800 (PST)
\r
17 Received: from mail-wy0-f181.google.com (mail-wy0-f181.google.com
\r
19 by olra.theworths.org (Postfix) with ESMTP id 174CB40DEF3
\r
20 for <notmuch@notmuchmail.org>; Fri, 19 Nov 2010 09:52:44 -0800 (PST)
\r
21 Received: by wyb40 with SMTP id 40so4959916wyb.26
\r
22 for <notmuch@notmuchmail.org>; Fri, 19 Nov 2010 09:52:44 -0800 (PST)
\r
23 Received: by 10.227.6.226 with SMTP id a34mr2589261wba.77.1290189164047;
\r
24 Fri, 19 Nov 2010 09:52:44 -0800 (PST)
\r
25 Received: from ut.hh.sledj.net (host81-149-164-25.in-addr.btopenworld.com
\r
27 by mx.google.com with ESMTPS id a17sm1261902wbe.0.2010.11.19.09.52.42
\r
28 (version=TLSv1/SSLv3 cipher=RC4-MD5);
\r
29 Fri, 19 Nov 2010 09:52:42 -0800 (PST)
\r
30 Received: by ut.hh.sledj.net (Postfix, from userid 1000)
\r
31 id 3BBE4594058; Fri, 19 Nov 2010 17:49:43 +0000 (GMT)
\r
32 From: David Edmondson <dme@dme.org>
\r
33 To: notmuch@notmuchmail.org
\r
34 Subject: [PATCH] emacs: Allow saved search queries to be dynamically
\r
36 Date: Fri, 19 Nov 2010 17:49:39 +0000
\r
37 Message-Id: <1290188979-7596-1-git-send-email-dme@dme.org>
\r
38 X-Mailer: git-send-email 1.7.2.3
\r
39 X-BeenThere: notmuch@notmuchmail.org
\r
40 X-Mailman-Version: 2.1.13
\r
42 List-Id: "Use and development of the notmuch mail system."
\r
43 <notmuch.notmuchmail.org>
\r
44 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,
\r
45 <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>
\r
46 List-Archive: <http://notmuchmail.org/pipermail/notmuch>
\r
47 List-Post: <mailto:notmuch@notmuchmail.org>
\r
48 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>
\r
49 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,
\r
50 <mailto:notmuch-request@notmuchmail.org?subject=subscribe>
\r
51 X-List-Received-Date: Fri, 19 Nov 2010 17:52:56 -0000
\r
53 >From an idea by Jed Brown: Allow the query string passed to notmuch by
\r
54 `notmuch-hello' to be the result of a function as well as a
\r
55 string. The function is passed no arguments and should return the
\r
58 A sample function `notmuch-hello-search-today' is provided.
\r
60 Update the customisation declaration of `notmuch-saved-searches'
\r
63 emacs/notmuch-hello.el | 396 +++++++++++++++++++++++++----------------------
\r
64 emacs/notmuch-lib.el | 4 +-
\r
65 emacs/notmuch.el | 9 +-
\r
66 3 files changed, 219 insertions(+), 190 deletions(-)
\r
68 diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
\r
69 index e58dd24..6337f45 100644
\r
70 --- a/emacs/notmuch-hello.el
\r
71 +++ b/emacs/notmuch-hello.el
\r
72 @@ -318,203 +318,229 @@ Complete list of currently available key bindings:
\r
73 ;;(setq buffer-read-only t)
\r
76 +(defun notmuch-hello-search-today ()
\r
77 + "Return a notmuch search for 'today'.
\r
79 +Convenience function for `notmuch-saved-searches'."
\r
81 + (format-time-string "%s" (seconds-to-time
\r
82 + (- (float-time (current-time))
\r
85 + (format-time-string "%s")))
\r
87 +(defun notmuch-hello-generate-saved-searches (saved-searches)
\r
88 + (loop for search-tuple in saved-searches
\r
89 + collect (cons (car search-tuple)
\r
90 + (let ((search (cdr search-tuple)))
\r
92 + ((functionp search)
\r
94 + (t ;; Assume a string
\r
98 (defun notmuch-hello (&optional no-display)
\r
99 "Run notmuch and display saved searches, known tags, etc."
\r
102 - ; Jump through a hoop to get this value from the deprecated variable
\r
103 - ; name (`notmuch-folders') or from the default value.
\r
104 + ;; Jump through a hoop to get this value from the deprecated variable
\r
105 + ;; name (`notmuch-folders') or from the default value.
\r
106 (if (not notmuch-saved-searches)
\r
107 (setq notmuch-saved-searches (notmuch-saved-searches)))
\r
110 - (set-buffer "*notmuch-hello*")
\r
111 - (switch-to-buffer "*notmuch-hello*"))
\r
113 - (let ((target (if (widget-at)
\r
114 - (widget-value (widget-at))
\r
115 - (condition-case nil
\r
117 - (widget-forward 1)
\r
118 - (widget-value (widget-at)))
\r
121 - (kill-all-local-variables)
\r
122 - (let ((inhibit-read-only t))
\r
125 - (unless (eq major-mode 'notmuch-hello-mode)
\r
126 - (notmuch-hello-mode))
\r
128 - (let ((all (overlay-lists)))
\r
129 - ;; Delete all the overlays.
\r
130 - (mapc 'delete-overlay (car all))
\r
131 - (mapc 'delete-overlay (cdr all)))
\r
133 - (when notmuch-show-logo
\r
134 - (let ((image notmuch-hello-logo))
\r
135 - ;; The notmuch logo uses transparency. That can display poorly
\r
136 - ;; when inserting the image into an emacs buffer (black logo on
\r
137 - ;; a black background), so force the background colour of the
\r
138 - ;; image. We use a face to represent the colour so that
\r
139 - ;; `defface' can be used to declare the different possible
\r
140 - ;; colours, which depend on whether the frame has a light or
\r
141 - ;; dark background.
\r
142 - (setq image (cons 'image
\r
143 - (append (cdr image)
\r
144 - (list :background (face-background 'notmuch-hello-logo-background)))))
\r
145 - (insert-image image))
\r
146 - (widget-insert " "))
\r
148 - (widget-insert "Welcome to ")
\r
149 - ;; Hack the display of the links used.
\r
150 - (let ((widget-link-prefix "")
\r
151 - (widget-link-suffix ""))
\r
152 - (widget-create 'link
\r
153 - :notify (lambda (&rest ignore)
\r
154 - (browse-url notmuch-hello-url))
\r
155 - :help-echo "Visit the notmuch website."
\r
157 - (widget-insert ". ")
\r
158 - (widget-insert "You have ")
\r
159 - (widget-create 'link
\r
160 - :notify (lambda (&rest ignore)
\r
161 - (notmuch-hello-update))
\r
162 - :help-echo "Refresh"
\r
163 - (notmuch-hello-nice-number
\r
164 - (string-to-number (car (process-lines notmuch-command "count")))))
\r
165 - (widget-insert " messages.\n"))
\r
167 - (let ((found-target-pos nil)
\r
168 - (final-target-pos nil))
\r
169 - (let* ((saved-alist
\r
170 - ;; Filter out empty saved seaches if required.
\r
171 - (if notmuch-show-empty-saved-searches
\r
172 - notmuch-saved-searches
\r
173 - (loop for elem in notmuch-saved-searches
\r
174 - if (> (string-to-number (notmuch-saved-search-count (cdr elem))) 0)
\r
176 - (saved-widest (notmuch-hello-longest-label saved-alist))
\r
177 - (alltags-alist (if notmuch-show-all-tags-list
\r
178 - (mapcar '(lambda (tag) (cons tag (concat "tag:" tag)))
\r
179 - (process-lines notmuch-command "search-tags"))))
\r
180 - (alltags-widest (notmuch-hello-longest-label alltags-alist))
\r
181 - (widest (max saved-widest alltags-widest)))
\r
183 - (when saved-alist
\r
184 - (widget-insert "\nSaved searches: ")
\r
185 - (widget-create 'push-button
\r
186 - :notify (lambda (&rest ignore)
\r
187 - (customize-variable 'notmuch-saved-searches))
\r
189 - (widget-insert "\n\n")
\r
190 - (setq final-target-pos (point-marker))
\r
191 - (let ((start (point)))
\r
192 - (setq found-target-pos (notmuch-hello-insert-tags saved-alist widest target))
\r
193 - (if found-target-pos
\r
194 - (setq final-target-pos found-target-pos))
\r
195 - (indent-rigidly start (point) notmuch-hello-indent)))
\r
197 - (widget-insert "\nSearch: ")
\r
198 - (setq notmuch-hello-search-bar-marker (point-marker))
\r
199 - (widget-create 'editable-field
\r
200 - ;; Leave some space at the start and end of the
\r
202 - :size (max 8 (- (window-width) notmuch-hello-indent
\r
203 - (length "Search: ")))
\r
204 - :action (lambda (widget &rest ignore)
\r
205 - (notmuch-hello-search (widget-value widget))))
\r
206 - (widget-insert "\n")
\r
208 - (when notmuch-hello-recent-searches
\r
209 - (widget-insert "\nRecent searches: ")
\r
210 - (widget-create 'push-button
\r
211 - :notify (lambda (&rest ignore)
\r
212 - (setq notmuch-hello-recent-searches nil)
\r
213 - (notmuch-hello-update))
\r
215 - (widget-insert "\n\n")
\r
216 - (let ((start (point))
\r
218 - (mapc '(lambda (search)
\r
219 - (let ((widget-symbol (intern (format "notmuch-hello-search-%d" nth))))
\r
220 - (set widget-symbol
\r
221 - (widget-create 'editable-field
\r
222 - ;; Don't let the search boxes be
\r
223 - ;; less than 8 characters wide.
\r
225 - (- (window-width)
\r
226 - ;; Leave some space
\r
227 - ;; at the start and
\r
230 - (* 2 notmuch-hello-indent)
\r
231 - ;; 1 for the space
\r
233 - ;; `[save]' button. 6
\r
234 - ;; for the `[save]'
\r
237 - :action (lambda (widget &rest ignore)
\r
238 - (notmuch-hello-search (widget-value widget)))
\r
240 - (widget-insert " ")
\r
241 - (widget-create 'push-button
\r
242 - :notify (lambda (widget &rest ignore)
\r
243 - (notmuch-hello-add-saved-search widget))
\r
244 - :notmuch-saved-search-widget widget-symbol
\r
246 - (widget-insert "\n")
\r
247 - (setq nth (1+ nth)))
\r
248 - notmuch-hello-recent-searches)
\r
249 - (indent-rigidly start (point) notmuch-hello-indent)))
\r
251 - (when alltags-alist
\r
252 - (widget-insert "\nAll tags: ")
\r
253 - (widget-create 'push-button
\r
254 - :notify (lambda (widget &rest ignore)
\r
255 - (setq notmuch-show-all-tags-list nil)
\r
256 - (notmuch-hello-update))
\r
258 - (widget-insert "\n\n")
\r
259 - (let ((start (point)))
\r
260 - (setq found-target-pos (notmuch-hello-insert-tags alltags-alist widest target))
\r
261 - (if (not final-target-pos)
\r
262 - (setq final-target-pos found-target-pos))
\r
263 - (indent-rigidly start (point) notmuch-hello-indent)))
\r
265 - (widget-insert "\n")
\r
267 - (if (not notmuch-show-all-tags-list)
\r
268 + ;; Generate the string version of all queries listed in
\r
269 + ;; `notmuch-saved-searches'. We do this here at the start so that
\r
270 + ;; the rest of the routine has a stable set to work from.
\r
271 + (let ((saved-searches (notmuch-hello-generate-saved-searches notmuch-saved-searches)))
\r
274 + (set-buffer "*notmuch-hello*")
\r
275 + (switch-to-buffer "*notmuch-hello*"))
\r
277 + (let ((target (if (widget-at)
\r
278 + (widget-value (widget-at))
\r
279 + (condition-case nil
\r
281 + (widget-forward 1)
\r
282 + (widget-value (widget-at)))
\r
285 + (kill-all-local-variables)
\r
286 + (let ((inhibit-read-only t))
\r
289 + (unless (eq major-mode 'notmuch-hello-mode)
\r
290 + (notmuch-hello-mode))
\r
292 + (let ((all (overlay-lists)))
\r
293 + ;; Delete all the overlays.
\r
294 + (mapc 'delete-overlay (car all))
\r
295 + (mapc 'delete-overlay (cdr all)))
\r
297 + (when notmuch-show-logo
\r
298 + (let ((image notmuch-hello-logo))
\r
299 + ;; The notmuch logo uses transparency. That can display poorly
\r
300 + ;; when inserting the image into an emacs buffer (black logo on
\r
301 + ;; a black background), so force the background colour of the
\r
302 + ;; image. We use a face to represent the colour so that
\r
303 + ;; `defface' can be used to declare the different possible
\r
304 + ;; colours, which depend on whether the frame has a light or
\r
305 + ;; dark background.
\r
306 + (setq image (cons 'image
\r
307 + (append (cdr image)
\r
308 + (list :background (face-background 'notmuch-hello-logo-background)))))
\r
309 + (insert-image image))
\r
310 + (widget-insert " "))
\r
312 + (widget-insert "Welcome to ")
\r
313 + ;; Hack the display of the links used.
\r
314 + (let ((widget-link-prefix "")
\r
315 + (widget-link-suffix ""))
\r
316 + (widget-create 'link
\r
317 + :notify (lambda (&rest ignore)
\r
318 + (browse-url notmuch-hello-url))
\r
319 + :help-echo "Visit the notmuch website."
\r
321 + (widget-insert ". ")
\r
322 + (widget-insert "You have ")
\r
323 + (widget-create 'link
\r
324 + :notify (lambda (&rest ignore)
\r
325 + (notmuch-hello-update))
\r
326 + :help-echo "Refresh"
\r
327 + (notmuch-hello-nice-number
\r
328 + (string-to-number (car (process-lines notmuch-command "count")))))
\r
329 + (widget-insert " messages.\n"))
\r
331 + (let ((found-target-pos nil)
\r
332 + (final-target-pos nil))
\r
333 + (let* ((saved-alist
\r
334 + ;; Filter out empty saved seaches if required.
\r
335 + (if notmuch-show-empty-saved-searches
\r
337 + (loop for elem in saved-searches
\r
338 + if (> (string-to-number (notmuch-saved-search-count (cdr elem))) 0)
\r
340 + (saved-widest (notmuch-hello-longest-label saved-alist))
\r
341 + (alltags-alist (if notmuch-show-all-tags-list
\r
342 + (mapcar '(lambda (tag) (cons tag (concat "tag:" tag)))
\r
343 + (process-lines notmuch-command "search-tags"))))
\r
344 + (alltags-widest (notmuch-hello-longest-label alltags-alist))
\r
345 + (widest (max saved-widest alltags-widest)))
\r
347 + (when saved-alist
\r
348 + (widget-insert "\nSaved searches: ")
\r
349 + (widget-create 'push-button
\r
350 + :notify (lambda (&rest ignore)
\r
351 + (customize-variable 'notmuch-saved-searches))
\r
353 + (widget-insert "\n\n")
\r
354 + (setq final-target-pos (point-marker))
\r
355 + (let ((start (point)))
\r
356 + (setq found-target-pos (notmuch-hello-insert-tags saved-alist widest target))
\r
357 + (if found-target-pos
\r
358 + (setq final-target-pos found-target-pos))
\r
359 + (indent-rigidly start (point) notmuch-hello-indent)))
\r
361 + (widget-insert "\nSearch: ")
\r
362 + (setq notmuch-hello-search-bar-marker (point-marker))
\r
363 + (widget-create 'editable-field
\r
364 + ;; Leave some space at the start and end of the
\r
366 + :size (max 8 (- (window-width) notmuch-hello-indent
\r
367 + (length "Search: ")))
\r
368 + :action (lambda (widget &rest ignore)
\r
369 + (notmuch-hello-search (widget-value widget))))
\r
370 + (widget-insert "\n")
\r
372 + (when notmuch-hello-recent-searches
\r
373 + (widget-insert "\nRecent searches: ")
\r
374 + (widget-create 'push-button
\r
375 + :notify (lambda (&rest ignore)
\r
376 + (setq notmuch-hello-recent-searches nil)
\r
377 + (notmuch-hello-update))
\r
379 + (widget-insert "\n\n")
\r
380 + (let ((start (point))
\r
382 + (mapc '(lambda (search)
\r
383 + (let ((widget-symbol (intern (format "notmuch-hello-search-%d" nth))))
\r
384 + (set widget-symbol
\r
385 + (widget-create 'editable-field
\r
386 + ;; Don't let the search boxes be
\r
387 + ;; less than 8 characters wide.
\r
389 + (- (window-width)
\r
390 + ;; Leave some space
\r
391 + ;; at the start and
\r
394 + (* 2 notmuch-hello-indent)
\r
395 + ;; 1 for the space
\r
397 + ;; `[save]' button. 6
\r
398 + ;; for the `[save]'
\r
401 + :action (lambda (widget &rest ignore)
\r
402 + (notmuch-hello-search (widget-value widget)))
\r
404 + (widget-insert " ")
\r
405 + (widget-create 'push-button
\r
406 + :notify (lambda (widget &rest ignore)
\r
407 + (notmuch-hello-add-saved-search widget))
\r
408 + :notmuch-saved-search-widget widget-symbol
\r
410 + (widget-insert "\n")
\r
411 + (setq nth (1+ nth)))
\r
412 + notmuch-hello-recent-searches)
\r
413 + (indent-rigidly start (point) notmuch-hello-indent)))
\r
415 + (when alltags-alist
\r
416 + (widget-insert "\nAll tags: ")
\r
417 (widget-create 'push-button
\r
418 :notify (lambda (widget &rest ignore)
\r
419 - (setq notmuch-show-all-tags-list t)
\r
420 + (setq notmuch-show-all-tags-list nil)
\r
421 (notmuch-hello-update))
\r
422 - "Show all tags")))
\r
424 - (let ((start (point)))
\r
425 - (widget-insert "\n\n")
\r
426 - (widget-insert "Type a search query and hit RET to view matching threads.\n")
\r
427 - (when notmuch-hello-recent-searches
\r
428 - (widget-insert "Hit RET to re-submit a previous search. Edit it first if you like.\n")
\r
429 - (widget-insert "Save recent searches with the `save' button.\n"))
\r
430 - (when notmuch-saved-searches
\r
431 - (widget-insert "Edit saved searches with the `edit' button.\n"))
\r
432 - (widget-insert "Hit RET or click on a saved search or tag name to view matching threads.\n")
\r
433 - (widget-insert "`=' refreshes this screen. `s' jumps to the search box. `q' to quit.\n")
\r
434 - (let ((fill-column (- (window-width) notmuch-hello-indent)))
\r
435 - (center-region start (point))))
\r
439 - (when final-target-pos
\r
440 - (goto-char final-target-pos)
\r
441 - (unless (widget-at)
\r
442 - (widget-forward 1)))
\r
444 + (widget-insert "\n\n")
\r
445 + (let ((start (point)))
\r
446 + (setq found-target-pos (notmuch-hello-insert-tags alltags-alist widest target))
\r
447 + (if (not final-target-pos)
\r
448 + (setq final-target-pos found-target-pos))
\r
449 + (indent-rigidly start (point) notmuch-hello-indent)))
\r
451 + (widget-insert "\n")
\r
453 + (if (not notmuch-show-all-tags-list)
\r
454 + (widget-create 'push-button
\r
455 + :notify (lambda (widget &rest ignore)
\r
456 + (setq notmuch-show-all-tags-list t)
\r
457 + (notmuch-hello-update))
\r
458 + "Show all tags")))
\r
460 + (let ((start (point)))
\r
461 + (widget-insert "\n\n")
\r
462 + (widget-insert "Type a search query and hit RET to view matching threads.\n")
\r
463 + (when notmuch-hello-recent-searches
\r
464 + (widget-insert "Hit RET to re-submit a previous search. Edit it first if you like.\n")
\r
465 + (widget-insert "Save recent searches with the `save' button.\n"))
\r
466 + (when notmuch-saved-searches
\r
467 + (widget-insert "Edit saved searches with the `edit' button.\n"))
\r
468 + (widget-insert "Hit RET or click on a saved search or tag name to view matching threads.\n")
\r
469 + (widget-insert "`=' refreshes this screen. `s' jumps to the search box. `q' to quit.\n")
\r
470 + (let ((fill-column (- (window-width) notmuch-hello-indent)))
\r
471 + (center-region start (point))))
\r
475 + (when final-target-pos
\r
476 + (goto-char final-target-pos)
\r
477 + (unless (widget-at)
\r
478 + (widget-forward 1)))
\r
480 - (unless (widget-at)
\r
481 - (notmuch-hello-goto-search)))))
\r
482 + (unless (widget-at)
\r
483 + (notmuch-hello-goto-search))))))
\r
485 (defun notmuch-folder ()
\r
486 "Deprecated function for invoking notmuch---calling `notmuch' is preferred now."
\r
487 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
\r
488 index 9d4e00f..9712f01 100644
\r
489 --- a/emacs/notmuch-lib.el
\r
490 +++ b/emacs/notmuch-lib.el
\r
493 (defcustom notmuch-saved-searches nil
\r
494 "A list of saved searches to display."
\r
495 - :type '(alist :key-type string :value-type string)
\r
496 + :type '(alist :key-type (string :tag "Name")
\r
497 + :value-type (choice (string :tag "Search")
\r
498 + (function :tag "Function")))
\r
501 (defvar notmuch-folders nil
\r
502 diff --git a/emacs/notmuch.el b/emacs/notmuch.el
\r
503 index b003cd6..e8d4d98 100644
\r
504 --- a/emacs/notmuch.el
\r
505 +++ b/emacs/notmuch.el
\r
506 @@ -808,10 +808,11 @@ characters as well as `_.+-'.
\r
508 (longest-length 0))
\r
509 (loop for tuple in notmuch-saved-searches
\r
510 - if (let ((quoted-query (regexp-quote (cdr tuple))))
\r
511 - (and (string-match (concat "^" quoted-query) query)
\r
512 - (> (length (match-string 0 query))
\r
513 - longest-length)))
\r
514 + if (and (stringp (cdr tuple))
\r
515 + (let ((quoted-query (regexp-quote (cdr tuple))))
\r
516 + (and (string-match (concat "^" quoted-query) query)
\r
517 + (> (length (match-string 0 query))
\r
518 + longest-length))))
\r
519 do (setq longest tuple))
\r
521 (saved-search-name (car saved-search))
\r
projects / notmuch-archives.git / blob