summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Edmondson <dme@dme.org>2010-04-29 11:33:36 +0100
committerCarl Worth <cworth@cworth.org>2010-10-27 17:41:50 -0700
commitc506e1034b5adb54b3e4f8d3e59086756f2bb126 (patch)
tree7fda3e5dc2e837473281c0754994fc791e2294bd
parentb67c3ed6094025558ebcdd608735d116a01997f8 (diff)
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.
-rw-r--r--emacs/notmuch-hello.el2
-rw-r--r--emacs/notmuch-show.el54
-rw-r--r--emacs/notmuch.el16
3 files changed, 52 insertions, 20 deletions
diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index 5970e3e..8dbb898 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 3fc3787..1055327 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)
@@ -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 42619b2..8d69fc8 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)
@@ -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))