emacs: Avoid runtime use of `cl'.

The GNU Emacs Lisp Reference Manual section D.1 says:

> *  Please don't require the cl package of Common Lisp extensions at
>    run time. Use of this package is optional, and it is not part of
>    the standard Emacs namespace. If your package loads cl at run time,
>    that could cause name clashes for users who don't use that package.
>
>    However, there is no problem with using the cl package at compile
>    time, with (eval-when-compile (require 'cl)). That's sufficient for
>    using the macros in the cl package, because the compiler expands
>    them before generating the byte-code.

Follow this advice, requiring the following changes where `cl' was
used at runtime:

- replace `rassoc-if' in `notmuch-search-buffer-title' with the `loop'
  macro and inline code. At the same time find the longest prefix
  which matches the query rather than simply the last,
- replace `union', `intersection' and `set-difference' in
  `notmuch-show-add-tag' and `notmuch-show-remove-tag' with local code
  to calculate the result of adding and removing a list of tags from
  another list of tags.

diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index 5970e3e57bef646a26d524b06e0711166948277e..8dbb89824397835c4cf5c6e61a6a8d26c3d44a47 100644 (file)
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -19,9 +19,9 @@
 ;;
 ;; Authors: David Edmondson <dme@dme.org>
 
+(eval-when-compile (require 'cl))
 (require 'widget)
 (require 'wid-edit) ; For `widget-forward'.
-(require 'cl)
 
 (require 'notmuch-lib)
 (require 'notmuch-mua)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 3fc3787c13496ed6c5b1f6a00077cf9496388b68..105532716c1cf6e5e9a79c2160fe11eb10539e70 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -21,7 +21,7 @@
 ;; Authors: Carl Worth <cworth@cworth.org>
 ;;          David Edmondson <dme@dme.org>
 
-(require 'cl)
+(eval-when-compile (require 'cl))
 (require 'mm-view)
 (require 'message)
 (require 'mm-decode)
@@ -942,29 +942,55 @@ than only the current message."
            (concat command " < " (shell-quote-argument (notmuch-show-get-filename)))))
     (start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" shell-command)))
 
+(defun notmuch-show-add-tags-worker (current-tags add-tags)
+  "Add to `current-tags' with any tags from `add-tags' not
+currently present and return the result."
+  (let ((result-tags (copy-seq current-tags)))
+    (mapc (lambda (add-tag)
+           (unless (member add-tag current-tags)
+             (setq result-tags (push add-tag result-tags))))
+           add-tags)
+    (sort result-tags 'string<)))
+
+(defun notmuch-show-del-tags-worker (current-tags del-tags)
+  "Remove any tags in `del-tags' from `current-tags' and return
+the result."
+  (let ((result-tags (copy-seq current-tags)))
+    (mapc (lambda (del-tag)
+           (setq result-tags (delete del-tag result-tags)))
+         del-tags)
+    result-tags))
+
 (defun notmuch-show-add-tag (&rest toadd)
   "Add a tag to the current message."
   (interactive
    (list (notmuch-select-tag-with-completion "Tag to add: ")))
-  (apply 'notmuch-call-notmuch-process
-        (append (cons "tag"
-                      (mapcar (lambda (s) (concat "+" s)) toadd))
-                (cons (notmuch-show-get-message-id) nil)))
-  (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<)))
+
+  (let* ((current-tags (notmuch-show-get-tags))
+        (new-tags (notmuch-show-add-tags-worker current-tags toadd)))
+
+    (unless (equal current-tags new-tags)
+      (apply 'notmuch-call-notmuch-process
+            (append (cons "tag"
+                          (mapcar (lambda (s) (concat "+" s)) toadd))
+                    (cons (notmuch-show-get-message-id) nil)))
+      (notmuch-show-set-tags new-tags))))
 
 (defun notmuch-show-remove-tag (&rest toremove)
   "Remove a tag from the current message."
   (interactive
    (list (notmuch-select-tag-with-completion
          "Tag to remove: " (notmuch-show-get-message-id))))
-  (let ((tags (notmuch-show-get-tags)))
-    (if (intersection tags toremove :test 'string=)
-       (progn
-         (apply 'notmuch-call-notmuch-process
-                (append (cons "tag"
-                              (mapcar (lambda (s) (concat "-" s)) toremove))
-                        (cons (notmuch-show-get-message-id) nil)))
-         (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<))))))
+
+  (let* ((current-tags (notmuch-show-get-tags))
+        (new-tags (notmuch-show-del-tags-worker current-tags toremove)))
+
+    (unless (equal current-tags new-tags)
+      (apply 'notmuch-call-notmuch-process
+            (append (cons "tag"
+                          (mapcar (lambda (s) (concat "-" s)) toremove))
+                    (cons (notmuch-show-get-message-id) nil)))
+      (notmuch-show-set-tags new-tags))))
 
 (defun notmuch-show-toggle-headers ()
   "Toggle the visibility of the current message headers."

diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 42619b266ba347101445dd4e7de09eb6bfc2142c..8d69fc8751082b12fedea6e042c066e33f9b77a2 100644 (file)
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -47,7 +47,7 @@
 ; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
 ; required, but is available from http://notmuchmail.org).
 
-(require 'cl)
+(eval-when-compile (require 'cl))
 (require 'mm-view)
 (require 'message)
 
@@ -741,10 +741,16 @@ characters as well as `_.+-'.
 
 (defun notmuch-search-buffer-title (query)
   "Returns the title for a buffer with notmuch search results."
-  (let* ((saved-search (rassoc-if (lambda (key)
-                                   (string-match (concat "^" (regexp-quote key))
-                                                 query))
-                                 (reverse (notmuch-saved-searches))))
+  (let* ((saved-search
+         (let (longest
+               (longest-length 0))
+           (loop for tuple in notmuch-saved-searches
+                 if (let ((quoted-query (regexp-quote (cdr tuple))))
+                      (and (string-match (concat "^" quoted-query) query)
+                           (> (length (match-string 0 query))
+                              longest-length)))
+                 do (setq longest tuple))
+           longest))
         (saved-search-name (car saved-search))
         (saved-search-query (cdr saved-search)))
     (cond ((and saved-search (equal saved-search-query query))