From: David Edmondson <dme@dme.org>
To: notmuch@notmuchmail.org
Subject: [PATCH 09/13] emacs: Avoid runtime use of `cl'.
Date: Wed, 19 May 2010 08:03:36 +0100
Message-Id: <1274252620-1249-10-git-send-email-dme@dme.org>
In-Reply-To: <1274252620-1249-1-git-send-email-dme@dme.org>
References: <1274252620-1249-1-git-send-email-dme@dme.org>
Precedence: list

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.
---
 emacs/notmuch-hello.el |    2 +-
 emacs/notmuch-show.el  |   54 +++++++++++++++++++++++++++++++++++------------
 emacs/notmuch.el       |   16 +++++++++----
 3 files changed, 52 insertions(+), 20 deletions(-)

diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index acf40bc..538785f 100644
--- 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 4b1baf3..ff1a7a7 100644
--- 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)
@@ -908,29 +908,55 @@ to stdout or stderr will appear in the *Messages* buffer."
 	 (list command " < "
 	       (shell-quote-argument (notmuch-show-get-filename)))))
 
+(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 7c9c028..c2fefe5 100644
--- 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)
 
@@ -712,10 +712,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))
-- 
1.7.1