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 56531409C88
\r
6 for <notmuch@notmuchmail.org>; Wed, 19 May 2010 01:54:47 -0700 (PDT)
\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 WFog5lHzk+XU for <notmuch@notmuchmail.org>;
\r
16 Wed, 19 May 2010 01:54:34 -0700 (PDT)
\r
17 Received: from mail-ew0-f213.google.com (mail-ew0-f213.google.com
\r
19 by olra.theworths.org (Postfix) with ESMTP id 851CC418C3C
\r
20 for <notmuch@notmuchmail.org>; Wed, 19 May 2010 01:53:46 -0700 (PDT)
\r
21 Received: by mail-ew0-f213.google.com with SMTP id 5so1814158ewy.0
\r
22 for <notmuch@notmuchmail.org>; Wed, 19 May 2010 01:53:46 -0700 (PDT)
\r
23 Received: by 10.213.75.139 with SMTP id y11mr3533814ebj.63.1274259226109;
\r
24 Wed, 19 May 2010 01:53:46 -0700 (PDT)
\r
25 Received: from ut.hh.sledj.net (host83-217-165-81.dsl.vispa.com
\r
27 by mx.google.com with ESMTPS id 15sm3497509ewy.12.2010.05.19.01.53.43
\r
28 (version=TLSv1/SSLv3 cipher=RC4-MD5);
\r
29 Wed, 19 May 2010 01:53:45 -0700 (PDT)
\r
30 Received: by ut.hh.sledj.net (Postfix, from userid 1000)
\r
31 id 12EAE5940B0; Wed, 19 May 2010 08:03:45 +0100 (BST)
\r
32 From: David Edmondson <dme@dme.org>
\r
33 To: notmuch@notmuchmail.org
\r
34 Subject: [PATCH 09/13] emacs: Avoid runtime use of `cl'.
\r
35 Date: Wed, 19 May 2010 08:03:36 +0100
\r
36 Message-Id: <1274252620-1249-10-git-send-email-dme@dme.org>
\r
37 X-Mailer: git-send-email 1.7.1
\r
38 In-Reply-To: <1274252620-1249-1-git-send-email-dme@dme.org>
\r
39 References: <1274252620-1249-1-git-send-email-dme@dme.org>
\r
40 X-BeenThere: notmuch@notmuchmail.org
\r
41 X-Mailman-Version: 2.1.13
\r
43 List-Id: "Use and development of the notmuch mail system."
\r
44 <notmuch.notmuchmail.org>
\r
45 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,
\r
46 <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>
\r
47 List-Archive: <http://notmuchmail.org/pipermail/notmuch>
\r
48 List-Post: <mailto:notmuch@notmuchmail.org>
\r
49 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>
\r
50 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,
\r
51 <mailto:notmuch-request@notmuchmail.org?subject=subscribe>
\r
52 X-List-Received-Date: Wed, 19 May 2010 08:54:47 -0000
\r
54 The GNU Emacs Lisp Reference Manual section D.1 says:
\r
56 > * Please don't require the cl package of Common Lisp extensions at
\r
57 > run time. Use of this package is optional, and it is not part of
\r
58 > the standard Emacs namespace. If your package loads cl at run time,
\r
59 > that could cause name clashes for users who don't use that package.
\r
61 > However, there is no problem with using the cl package at compile
\r
62 > time, with (eval-when-compile (require 'cl)). That's sufficient for
\r
63 > using the macros in the cl package, because the compiler expands
\r
64 > them before generating the byte-code.
\r
66 Follow this advice, requiring the following changes where `cl' was
\r
69 - replace `rassoc-if' in `notmuch-search-buffer-title' with the `loop'
\r
70 macro and inline code. At the same time find the longest prefix
\r
71 which matches the query rather than simply the last,
\r
72 - replace `union', `intersection' and `set-difference' in
\r
73 `notmuch-show-add-tag' and `notmuch-show-remove-tag' with local code
\r
74 to calculate the result of adding and removing a list of tags from
\r
75 another list of tags.
\r
77 emacs/notmuch-hello.el | 2 +-
\r
78 emacs/notmuch-show.el | 54 +++++++++++++++++++++++++++++++++++------------
\r
79 emacs/notmuch.el | 16 +++++++++----
\r
80 3 files changed, 52 insertions(+), 20 deletions(-)
\r
82 diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
\r
83 index acf40bc..538785f 100644
\r
84 --- a/emacs/notmuch-hello.el
\r
85 +++ b/emacs/notmuch-hello.el
\r
88 ;; Authors: David Edmondson <dme@dme.org>
\r
90 +(eval-when-compile (require 'cl))
\r
92 (require 'wid-edit) ; For `widget-forward'.
\r
95 (require 'notmuch-lib)
\r
96 (require 'notmuch-mua)
\r
97 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
\r
98 index 4b1baf3..ff1a7a7 100644
\r
99 --- a/emacs/notmuch-show.el
\r
100 +++ b/emacs/notmuch-show.el
\r
102 ;; Authors: Carl Worth <cworth@cworth.org>
\r
103 ;; David Edmondson <dme@dme.org>
\r
106 +(eval-when-compile (require 'cl))
\r
109 (require 'mm-decode)
\r
110 @@ -908,29 +908,55 @@ to stdout or stderr will appear in the *Messages* buffer."
\r
111 (list command " < "
\r
112 (shell-quote-argument (notmuch-show-get-filename)))))
\r
114 +(defun notmuch-show-add-tags-worker (current-tags add-tags)
\r
115 + "Add to `current-tags' with any tags from `add-tags' not
\r
116 +currently present and return the result."
\r
117 + (let ((result-tags (copy-seq current-tags)))
\r
118 + (mapc (lambda (add-tag)
\r
119 + (unless (member add-tag current-tags)
\r
120 + (setq result-tags (push add-tag result-tags))))
\r
122 + (sort result-tags 'string<)))
\r
124 +(defun notmuch-show-del-tags-worker (current-tags del-tags)
\r
125 + "Remove any tags in `del-tags' from `current-tags' and return
\r
127 + (let ((result-tags (copy-seq current-tags)))
\r
128 + (mapc (lambda (del-tag)
\r
129 + (setq result-tags (delete del-tag result-tags)))
\r
133 (defun notmuch-show-add-tag (&rest toadd)
\r
134 "Add a tag to the current message."
\r
136 (list (notmuch-select-tag-with-completion "Tag to add: ")))
\r
137 - (apply 'notmuch-call-notmuch-process
\r
138 - (append (cons "tag"
\r
139 - (mapcar (lambda (s) (concat "+" s)) toadd))
\r
140 - (cons (notmuch-show-get-message-id) nil)))
\r
141 - (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<)))
\r
143 + (let* ((current-tags (notmuch-show-get-tags))
\r
144 + (new-tags (notmuch-show-add-tags-worker current-tags toadd)))
\r
146 + (unless (equal current-tags new-tags)
\r
147 + (apply 'notmuch-call-notmuch-process
\r
148 + (append (cons "tag"
\r
149 + (mapcar (lambda (s) (concat "+" s)) toadd))
\r
150 + (cons (notmuch-show-get-message-id) nil)))
\r
151 + (notmuch-show-set-tags new-tags))))
\r
153 (defun notmuch-show-remove-tag (&rest toremove)
\r
154 "Remove a tag from the current message."
\r
156 (list (notmuch-select-tag-with-completion
\r
157 "Tag to remove: " (notmuch-show-get-message-id))))
\r
158 - (let ((tags (notmuch-show-get-tags)))
\r
159 - (if (intersection tags toremove :test 'string=)
\r
161 - (apply 'notmuch-call-notmuch-process
\r
162 - (append (cons "tag"
\r
163 - (mapcar (lambda (s) (concat "-" s)) toremove))
\r
164 - (cons (notmuch-show-get-message-id) nil)))
\r
165 - (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<))))))
\r
167 + (let* ((current-tags (notmuch-show-get-tags))
\r
168 + (new-tags (notmuch-show-del-tags-worker current-tags toremove)))
\r
170 + (unless (equal current-tags new-tags)
\r
171 + (apply 'notmuch-call-notmuch-process
\r
172 + (append (cons "tag"
\r
173 + (mapcar (lambda (s) (concat "-" s)) toremove))
\r
174 + (cons (notmuch-show-get-message-id) nil)))
\r
175 + (notmuch-show-set-tags new-tags))))
\r
177 (defun notmuch-show-toggle-headers ()
\r
178 "Toggle the visibility of the current message headers."
\r
179 diff --git a/emacs/notmuch.el b/emacs/notmuch.el
\r
180 index 7c9c028..c2fefe5 100644
\r
181 --- a/emacs/notmuch.el
\r
182 +++ b/emacs/notmuch.el
\r
184 ; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
\r
185 ; required, but is available from http://notmuchmail.org).
\r
188 +(eval-when-compile (require 'cl))
\r
192 @@ -712,10 +712,16 @@ characters as well as `_.+-'.
\r
194 (defun notmuch-search-buffer-title (query)
\r
195 "Returns the title for a buffer with notmuch search results."
\r
196 - (let* ((saved-search (rassoc-if (lambda (key)
\r
197 - (string-match (concat "^" (regexp-quote key))
\r
199 - (reverse (notmuch-saved-searches))))
\r
200 + (let* ((saved-search
\r
202 + (longest-length 0))
\r
203 + (loop for tuple in notmuch-saved-searches
\r
204 + if (let ((quoted-query (regexp-quote (cdr tuple))))
\r
205 + (and (string-match (concat "^" quoted-query) query)
\r
206 + (> (length (match-string 0 query))
\r
207 + longest-length)))
\r
208 + do (setq longest tuple))
\r
210 (saved-search-name (car saved-search))
\r
211 (saved-search-query (cdr saved-search)))
\r
212 (cond ((and saved-search (equal saved-search-query query))
\r