[PATCH] emacs: Avoid runtime use of `cl'.
David Edmondson
dme at dme.org
Thu Apr 29 03:33:36 PDT 2010
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.
---
This change requires some careful review, particularly for the code
which manipulates sets 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 at 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 at cworth.org>
;; David Edmondson <dme at 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 at 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.0
More information about the notmuch
mailing list